Office: (Office 2007) chaotisches Lagersystem

LagerToni · 22. April 2009

Hey,

hab da mal ne Frage:

Kannst Du mir da nochmal helfen, wie man den aktuellen Bestand der Artikel anzeigen lassen kann? Und dass dieser sich bei Ein- und Auslagerungen ändert... krrieg das nicht hin... :-(

Gruß Christian

jinx · 22. April 2009

Moin, Christian,

in einer eigenen Mappe oder als Teil der bestehenden? Wenn der zweite Fall zutrifft, wie wird der Bestand des Kleinteilelagers aufgefüllt - aus dem Hauptlager oder durch JIT-Anlieferung (gilt sinngemäß auch für eine eigene Mappe)?

LagerToni · 23. April 2009

Hi,
also der Bestand des Kleinteilelagers ändert sich immer je nach Bestellung, also quasi JIT. Wir kaufen manchmal größere Mengen von einem Artikel ein, der dann nach und nach abverkauft wird. Ich möchte eben nur, dass das Programm jede Ein- und Auslagerung dokumentiert und eine Übersicht des Bestandes jeden Artikels haben...

Gruß Christian

OfficeUser · 24. April 2009

Moin, Christian,

einen Blumentopf für den Code werde ich nicht gewinnen können (zur Zeit erhalte ich beim Feststellen der Fundstellen auf Lagerbuch mit schöner Regelmäßigkeit einen Laufzeitfehler, deshalb z.B. der Wechsel der Tabellen; ich bin wohl mehr als reif für das, in was ich demnächst aufmachen werde) - da fehlen noch der Sicherheitsbestand, die eventuelle Neubestellung bei Unterschreitung Meldebestand usw. usf. Dieser Code ist wieder nur als Idee gedacht, wie man das Problem lösen könnte.

Code:

'basUmschreiben
Option Explicit

Sub Umschreiben()

Dim lngZeile As Long
Dim lngSpalte As Long
Dim lngFreie As Long
Dim lngMid As Long
Dim lngLeft As Long
Dim strSuche As String
Dim rngZelle As Range
Dim lngFreeCell As Long
Dim strErsteAdresse As String
Dim strLagerplatz As String
Dim lngLastFound As Long
Dim varRest As Variant

If ActiveSheet.ListBox1.ListIndex = -1 Then
MsgBox "Bitte treffen Sie erst eine Auswahl über den Lagerplatz!", vbExclamation, "Kein Lagerplatz"
End
End If

lngFreie = Lagerbuch.Cells(Rows.Count, "A").End(xlUp).Row + 1

With ActiveSheet
Ausdruck.Range("B2").Value = .Name
Select Case .Name
Case "Einlagerung"
lngMid = 7
If .Range("F1").Value < 998 Then
.Range("F1").Value = .Range("F1").Value + 1
Else
.Range("F1").Value = 1
End If
strSuche = .Range("B3").Value & " - " & Format(Date, "YYMMDD") & Format(.Range("F1"), "000")
Lagerbuch.Cells(lngFreie, "A").Value = strSuche
Lagerbuch.Cells(lngFreie, "B").Value = Date
Lagerbuch.Cells(lngFreie, "C").Value = .Range("B3").Value
Lagerbuch.Cells(lngFreie, "D").Value = Mid(.ListBox1.Text, lngMid, 2) & " - " & Right(.ListBox1.Text, 1)
Lagerbuch.Cells(lngFreie, "E").Value = .Range("B6").Value
Lagerbuch.Cells(lngFreie, "G").Value = 0
Lagerbuch.Cells(lngFreie, "H").Value = .Range("B6").Value
Lagerplatz.Cells(Mid(.ListBox1.Text, lngMid, 2) + 1, Right(.ListBox1.Text, 1) + 1).Value = strSuche & " - " & Format(.Range("B6").Value, "0000")

Case "Auslagerung"
lngFreeCell = Lagerbuch.Cells(Rows.Count, "A").End(xlUp).Row + 1
If lngFreeCell > Rows.Count Then
MsgBox "Lagerdatei bitte archivieren und Platz schaffen.", vbInformation, "Abbruch"
End
End If

varRest = vbNullString

If Mid(.ListBox1.Text, 12, 4) - .Range("B6").Value < 0 Then
MsgBox "Auslieferung muss aufgeteilt werden!", vbExclamation, "Hinweis"
varRest = Abs(Mid(.ListBox1.Text, 12, 4) - .Range("B6").Value)
.Range("B6").Value = Mid(.ListBox1.Text, 12, 4)
End If

lngMid = 21
strSuche = .Range("B3").Value & " - " & Right("0" & Trim(Left(.ListBox1.Text, 9)), 10)
Set rngZelle = Lagerbuch.Columns("A:A").Find( _
what:=strSuche, LookIn:=xlValues, lookat:=xlWhole, _
searchorder:=xlByRows, After:=Lagerbuch.Cells(Rows.Count, "A"))
If Not rngZelle Is Nothing Then
Application.Goto reference:=Lagerbuch.Range("A1")
strErsteAdresse = rngZelle.Address
Do While ActiveCell.Address strErsteAdresse
Set rngZelle = Cells.FindNext(After:=rngZelle.Offset(, 1))
If rngZelle.Address = strErsteAdresse Then Exit Do
lngLastFound = rngZelle.Row
Loop
End If
Lagerbuch.Range("A" & lngFreeCell & ":H" & lngFreeCell).Value = _
Lagerbuch.Range("A" & lngLastFound & ":H" & lngLastFound).Value
Lagerbuch.Cells(lngFreeCell, "G").Value = .Range("B6").Value
Lagerbuch.Cells(lngFreeCell, "F").Value = Date
Lagerbuch.Cells(lngFreeCell, "H").Value = Lagerbuch.Cells(lngLastFound, "H").Value - Lagerbuch.Cells(lngFreeCell, "G").Value
Set rngZelle = Nothing
Sheets(Ausdruck.Range("B2").Value).Activate
If Lagerbuch.Cells(lngFreeCell, "H").Value = 0 Then
Lagerplatz.Cells(Mid(.ListBox1.Text, lngMid, 2) + 1, Right(.ListBox1.Text, 1) + 1).Value = vbNullString
Else
strLagerplatz = Lagerplatz.Cells(Mid(.ListBox1.Text, lngMid, 2) + 1, Right(.ListBox1.Text, 1) + 1).Value
Debug.Print strLagerplatz
Lagerplatz.Cells(Mid(.ListBox1.Text, lngMid, 2) + 1, Right(.ListBox1.Text, 1) + 1).Value = Left(strLagerplatz, Len(strLagerplatz) - 4) & Format(Lagerbuch.Cells(lngFreeCell, "H").Value, "0000")
End If
End Select

Ausdruck.Range("C4").Value = .Range("B3").Value
Ausdruck.Range("C5").Value = .Range("B5").Value
Ausdruck.Range("C6").Value = .Range("B4").Value
Ausdruck.Range("C7").Value = .Range("B6").Value
Ausdruck.Range("C10").Value = Mid(.ListBox1.Text, lngMid, 2)
Ausdruck.Range("C11").Value = Right(.ListBox1.Text, 1)
Ausdruck.Range("C13").Value = strSuche

Ausdruck.PrintPreview
' Ausdruck.PrintOut

Application.EnableEvents = False
.Range("B3").Value = vbNullString
.Range("B6").Value = varRest
Application.EnableEvents = True
.ListBox1.Clear
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Lagerbuch

A B C D E F G H
1 ID Eingangsdatum Kurz Ort Stückzahl Einlagerung Ausgangsdatum Ausgang Rest
2 H001 - 090424006 24.04.2009 H001 01 - 1 111 0 111
3 H001 - 090424006 24.04.2009 H001 01 - 1 111 24.04.2009 11 100

LagerToni · 28. April 2009

Hey, danke dir nochmal recht herzlich. Das sieht ja schon super aus. Was meinste muss man debuggen, damit der Code funktioniert? Hab im Lagerbuch gesehen, dass du trotzd es Lauftzeitfehlers die Auslagerungen hinbekommen hast...
Sowas wie Sicherheits- melde- und Hastenichtgesehenbestand brauchen wir nicht. Nur die Ein- und Auslagerungen... Dankedankedanke

jinx · 2. Mai 2009

Moin, Christian,

da ich nicht weiß, was bei Dir nicht funktioniert, kann ich Dir auch nur schlecht einen Tipp geben, was Du ändern musst - bei mir hat der Code (trotz des Umweges) das richtige Ergebnis gebracht. Wenn Du mich bezüglich des Fehlers bitte "aufklären" könntest... *grins

Ketienne · 8. Dezember 2013

Hallo Zusammen,

ich habe leider nur sehr wenig Ahnung vom Makros schreiben geschweige denn von VBA. Die Beispieldatei würde ich dennoch gerne in einer abgewandelten Version verwenden. Habe bestimmt schon mehr als 8 Stunden probiert das Ganze für meine Zwecke umzuschreiben nur leider ohne Erfolg.

Meine Frage ans Forum kann mir hier vielleicht irgendjemand das ganze so abändern das der Lagerplatz nur noch aus einer Spalte besteht und der Rest wegfällt ?

Ich hoffe dass ich nicht zu dreist bin.

Vielen Dank schonmal

Office: (Office 2007) chaotisches Lagersystem

chaotisches Lagersystem

chaotisches Lagersystem

chaotisches Lagersystem

chaotisches Lagersystem - Similar Threads - chaotisches Lagersystem

Einfaches Lagersystem Erstellen

Makro für ein kleines eigenes Lagersystem

Chaotische Adressen trennen

	A	B	C	D	E	F	G	H
1	ID	Eingangsdatum	Kurz	Ort	Stückzahl Einlagerung	Ausgangsdatum	Ausgang	Rest
2	H001 - 090424006	24.04.2009	H001	01 - 1	111		0	111
3	H001 - 090424006	24.04.2009	H001	01 - 1	111	24.04.2009	11	100