Public status As String
Sub Einbuchen11()
Dim sp As Long
Dim sachNummer As String
Dim anzahlLT As Integer
Dim Schicht As Long
Dim umgebuchtLT As Integer
Dim Netzwerk As Object
On Error Resume Next
zl = 0
zl = Columns([spGasse]).Find(what:=meinWert, LookAt:=xlWhole).Row
On Error GoTo 0
sp = [spAnzahl-4]
If Cells(1, 10).Value = "-Label" Then
Gasse:
If Cells(2, 10).Value = "einbuchen" Then
Dim gasseBarcode As String
zl = 4
gasseBarcode = InputBox("In welche Gasse wird eingebucht?")
If StrPtr(gasseBarcode) = 0 Then
Exit Sub
Else
On Error Resume Next
Do While Cells(zl, 3).Value <> "Ende"
If Cells(zl, 3).Value = gasseBarcode Then
zl = zl
GoTo Mesut:
End If
zl = zl + 1
Loop
End If
End If
Mesut:
If Cells(2, 10).Value = "einbuchen" Then
sachNummer1:
Rows(zl).Font.Name = "Arial Black"
Cells(zl, sp + 1).Select
sachNummer = InputBox("Scannen Sie die gewünschten Sachnummer", "Welche Sachnummer soll zustäzlich eingebucht werden?")
sachNummer = Left(sachNummer, 17)
Stückzahl = Right(sachNummer, 2)
If StrPtr(sachNummer) = 0 Then
Rows(zl).Font.Name = "Arial"
Exit Sub
Else
Select Case sachNummer:
Case "R2312710300":
sachNummer = "R 231 271 03 00"
Case "A2056164301 5100":
sachNummer = "A 205 616 43 01 5100"
End Select
Cells(3, 10).Value = sachNummer
If Cells(2, 11).Value = 0 Then
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.1
GoTo Nad1:
End If
zl = zl + 1
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.2
GoTo Nad1:
End If
zl = zl + 1
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.3
GoTo Nad1:
End If
MsgBox ("Diese Sachnummer ist nicht in der Gasse vorhanden")
GoTo Ende1:
End If
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
Nad1:
Cells(zl, sp + 2).Select
STATIS.Show
Select Case status:
Case "1":
status = "frei"
Case "2":
status = "ungestanzt/NA"
Case "3":
status = "gesperrt"
Case "4":
status = "imprägnieren"
Case "5":
status = "Probe / Muster - Versuch"
End Select
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value = status)) Then
GoTo wini:
End If
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value <> status)) Then
If Cells(2, 11).Value = 0.1 Then
Cells(2, 11).Value = 0.12
zl = zl + 1
GoTo a:
End If
If Cells(2, 11).Value = 0.2 Then
Cells(2, 11).Value = 0.23
zl = zl + 1
GoTo b:
End If
If Cells(2, 11).Value = 0.3 Then
Cells(2, 11).Value = 0.32
zl = zl - 1
GoTo c:
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
sachNummer2:
Rows(zl).Font.Name = "Arial Black"
Cells(zl, sp + 1).Select
sachNummer = InputBox("Scannen Sie die gewünschten Sachnummer", "Welche Sachnummer soll eingebucht werden?")
sachNummerLi = Left(sachNummer, 17)
Stückzahl = Right(sachNummer, 2)
If StrPtr(sachNummer) = 0 Then
Exit Sub
Else
Select Case sachNummerLi:
Case "R2312710300":
sachNummer = "R 231 271 03 00"
Case "R1570103600 5710":
sachNummer = "R 157 010 36 00 5710"
End Select
Cells(3, 10).Value = sachNummer
If Cells(2, 11).Value = 3 Then
zl = zl - 2
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 3.1
GoTo Nad:
End If
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 3.2
GoTo Nad:
End If
zl = zl + 1
GoTo Fall1:
End If
If Cells(2, 11).Value = 2 Then
zl = zl - 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 2.1
GoTo Nad:
End If
zl = zl + 2
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 2.3
GoTo Nad:
End If
zl = zl - 1
GoTo Fall1:
End If
If Cells(2, 11).Value = 1 Then
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 1.2
GoTo Nad:
End If
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 1.3
GoTo Nad:
End If
zl = zl - 2
GoTo Fall1:
End If
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
Nad:
Cells(zl, sp + 2).Select
STATIS.Show
Select Case status:
Case "1":
status = "frei"
Case "2":
status = "ungestanzt/NA"
Case "3":
status = "gesperrt"
Case "4":
status = "imprägnieren"
Case "5":
status = "Probe / Muster - Versuch"
End Select
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value = status)) Then
GoTo wini:
End If
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value <> status)) Then
If Cells(2, 11).Value = 1.2 Then
Cells(2, 11).Value = 1.23
zl = zl + 1
GoTo 11:
End If
If Cells(2, 11).Value = 1.3 Then
zl = zl - 2
Call Einbuchen22
End If
If Cells(2, 11).Value = 2.1 Then
Cells(2, 11).Value = 2.13
zl = zl + 2
GoTo 22:
End If
If Cells(2, 11).Value = 2.3 Then
zl = zl - 1
Call Einbuchen22
End If
If Cells(2, 11).Value = 3.1 Then
Cells(2, 11).Value = 3.12
zl = zl + 1
GoTo 33:
End If
If Cells(2, 11).Value = 3.2 Then
zl = zl + 1
Call Einbuchen22
End If
End If
End If
End Sub