mir wurde bereits bei meinem letzten Problem absolut super geholfen.
Nun geht die Suche weiter
Ich habe eine Excel datei, mit 2 Arbeitsblättern.
Arbeitsblatt OUT und IN
Ich befülle Arbeitsblatt IN beginned ab D4 abwärts mit Werten.
sobald ich alle Werte eingetragen habe betätige ich einen Button, der IN und OUT abgleicht.
In Spalte C4 (bis Cxxx) steht die Anzahl
In Spalte D4 (bis xxx) steht die Artikelbezeichnung
nun soll geprüft werden, welche Anzahl von welchem Produkt in IN vorhanden ist und diese aus dem Blatt OUT enstsprechend reduziert werden.
Ist die Zahl gleich oder kleiner 0 soll nur die entsprechende Zelle D gelöscht werden (habe hier schon vorgearbeitet, dass der Rest sich automatisch löscht)
Zur Veranschaulichung habe ich die Excel Datei mal mit angehängt
diesen Ansatz würde ich noch einmal überdenken. Gleichartige Daten gehören auf ein Tabellenblatt. Eingang und Ausgang können in einer dafür eingerichteten Spalte gekennzeichnet werden.
Viele Grüße
Klaus-Dieter Der Erfolg hat viele Väter, der Misserfolg ist ein Waisenkind Richard Cobden
diesen Ansatz würde ich noch einmal überdenken. Gleichartige Daten gehören auf ein Tabellenblatt. Eingang und Ausgang können in einer dafür eingerichteten Spalte gekennzeichnet werden.
ich arbeite mit einem Barcodescanner und mehreren Benutzer.
Hier ist es unumgänglich, dass ich zwei getrennte Tabellenblätter nutze (Schon alleine für den start des "Scannvorgangs").
Ich hatte zuerst schon 2 getrennte Dateien aber das wäre insgesamt zu aufwendig geworden.
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If .Cells(i, "C") > 0 Then
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
Else
raFund.ClearContents
End If
End If
Next i
End With
Danke dafür!
Der Code funktioniert erstmal so wie gewünscht.
Allerdings zählt er auch nach 0 immer weiter nach unten (also in den Minusbereich).
Hier sollte er bei erreichen von 0 die Zeile einfach komplett löschen (im Blatt OUT).
Gruß,
Carsten
(06.10.2021, 12:41)Werner.M schrieb: Hallo,
Code:
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If .Cells(i, "C") > 0 Then
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
Else
raFund.ClearContents
End If
End If
Next i
End With
da hatte ich dich offensichtlich falsch verstanden.
Code:
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raFund.Offset(, -1) > 0 Then
If raFund.Offset(, -1) - .Cells(i, "C") = 0 Then
raFund.ClearContents
Else
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
End If
End If
End If
Next i
End With
End Sub
Danke dir Werner, so macht er das was ich möchte.
Habe zwar noch einen Fehler, da sich der Code wohl mit meinem anderen Beißt aber das bekomme ich noch hin, denke ich
(06.10.2021, 13:12)Werner.M schrieb: Hallo,
da hatte ich dich offensichtlich falsch verstanden.
Code:
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raFund.Offset(, -1) > 0 Then
If raFund.Offset(, -1) - .Cells(i, "C") = 0 Then
raFund.ClearContents
Else
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
End If
End If
End If
Next i
End With
End Sub
Könntest du mir noch eine MsgBox einbauen, die mich darauf hinweißt, falls ein Wert NICHT in OUT gefunden werden konnte?
Die MsgBox sollte dann die Zeile und die Bezeichnung aus $D enthalten
nur falls möglich
(06.10.2021, 14:12)master2011 schrieb: Danke dir Werner, so macht er das was ich möchte.
Habe zwar noch einen Fehler, da sich der Code wohl mit meinem anderen Beißt aber das bekomme ich noch hin, denke ich
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raFund.Offset(, -1) > 0 Then
If raFund.Offset(, -1) - .Cells(i, "C") = 0 Then
raFund.ClearContents
Else
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
End If
End If
Else
MsgBox "Der Artikel " & .Cells(i, "D") & " aus Zeile " & i & " wurde nicht gefunden."
End If
Next i
End With
End Sub
Public Sub Abgleich()
Dim i As Long, raFund As Range
Application.ScreenUpdating = False
With Worksheets("IN")
For i = 4 To .Cells(.Rows.Count, "D").End(xlUp).Row
Set raFund = Worksheets("OUT").Columns("D").Find(what:=.Cells(i, "D"), LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
If raFund.Offset(, -1) > 0 Then
If raFund.Offset(, -1) - .Cells(i, "C") = 0 Then
raFund.ClearContents
Else
raFund.Offset(, -1) = raFund.Offset(, -1) - .Cells(i, "C")
End If
End If
Else
MsgBox "Der Artikel " & .Cells(i, "D") & " aus Zeile " & i & " wurde nicht gefunden."
End If
Next i
End With
End Sub
VBA abändern für WENN DANN funktion
