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, 13: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, 14: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, 15: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
