Zellwerte in externer Tabelle finden
22.01.2023 10:34:19
Much
Habe untenstehende Code geschrieben, der soweit funktioniert.
Mein Problem damit ist folgendes.
Ich möchte aus der tab_Auftrag, die tab_Statistik ergänzen, wenn ein neuer Auftrag geschrieben wurde.
Soweit habe ich es geschafft, auch die Auftragsrücknahme funftioniert.
Das Problem er vergleicht nur die Artikelnummer (tab_Auftrab!B) und diese kommt in tab_Statistik mehrfach aber mit anderen Farbenamen vor, daher schreibt er mir in all den gefundenen Artikelnummern die Mengen der Order.
Ich müsste somit Artikelnummer und Farbname vergleichen um die richtige Zeile zu finden. Habe auch schon versucht Zeilenweise zu vergleichen, komm aber nicht auf die richtige Lösung.
Weiters ist der Code recht langsam!
Hoffe es ist verständlich, und Ihr könnt mir helfen.
Vielen Dank im voraus.
lg Much
Sub OrderStatistik()
Dim MsgErgebnis As VbMsgBoxResult, MsgOrder As VbMsgBoxResult
Dim iRowL As Integer, iRow As Integer, LZ As Integer, iCol As Integer
Dim OrderNrA As String, OrderNrV As String, rngVrgl As String, rngVrgl2 As String
Dim rng As Range, rngCol As Range
tab_Statistik.Activate
rngVrgl = Sheets("Auftrag").Range("D12") & " " & Sheets("Auftrag").Range("D13")
rngVrgl2 = tab_Statistik.Range("A1") & " " & tab_Statistik.Range("C1").Value
If rngVrgl = rngVrgl2 = True Then
OrderNrA = Sheets("Auftrag").Range("D8")
With tab_Statistik
OrderNrV = Application.WorksheetFunction.CountIf(Range("M:M"), OrderNrA) > 0
End With
If OrderNrV = False Then
MsgOrder = MsgBox("Möchten Sie die Order " & OrderNrA & " in die Statistik übernehmen?", vbYesNo + vbQuestion + vbDefaultButton2, _
"Order verarbeiten?")
Select Case MsgOrder
Case vbYes:
With tab_Statistik
LZ = .Cells(Rows.Count, 1).End(xlUp).Row
iRowL = .Cells(Rows.Count, 13).End(xlUp).Row + 1
Cells(iRowL, 13).Value = OrderNrA
End With
With tab_auftrag
For iRow = 3 To LZ
Set rng = .Cells.Find(Cells(iRow, 1), lookat:=xlWhole, LookIn:=xlValues)
Set rngCol = .Cells.Find(Cells(iRow, 5), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
Cells(iRow, 6) = .Cells(rng.Row, 9) + .Cells(iRow, 6).Value
Cells(iRow, 7) = .Cells(rng.Row, 10) + Cells(iRow, 7).Value
Cells(iRow, 8) = .Cells(rng.Row, 11) + Cells(iRow, 8).Value
Cells(iRow, 9) = .Cells(rng.Row, 12) + Cells(iRow, 9).Value
Cells(iRow, 10) = .Cells(rng.Row, 13) + Cells(iRow, 10).Value
End If
Next iRow
End With
Case vbNo: Exit Sub
End Select
Else
MsgErgebnis = MsgBox("Order " & OrderNrA & " wurde schon eingefügt!" & vbCrLf & vbCrLf & "Möchte Sie die Order zurücknehmen?", _
vbYesNo + vbQuestion + vbDefaultButton2, "Hinweis")
Select Case MsgErgebnis
Case vbYes:
With tab_Statistik
LZ = .Cells(Rows.Count, 1).End(xlUp).Row
iRowL = .Cells(Rows.Count, 13).End(xlUp).Row
OrderNrV = Cells(iRowL, 13).ClearContents
End With
With tab_auftrag
For iRow = 3 To LZ
Set rng = .Cells.Find(Cells(iRow, 1), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
Cells(iRow, 6) = Cells(iRow, 6) - .Cells(rng.Row, 9)
Cells(iRow, 7) = Cells(iRow, 7) - .Cells(rng.Row, 10)
Cells(iRow, 8) = Cells(iRow, 8) - .Cells(rng.Row, 11)
Cells(iRow, 9) = Cells(iRow, 9) - .Cells(rng.Row, 12)
Cells(iRow, 10) = Cells(iRow, 10) - .Cells(rng.Row, 13)
End If
Next iRow
End With
Case vbNo: Exit Sub
End Select
End If
Else
MsgBox "kein gültiges Statistikformular zu dieser Saison vorhanden!", vbOKOnly + vbInformation, "...ungültiges Formular!"
Exit Sub
End If
tab_auftrag.Activate
End Sub