Clever-Excel-Forum

Normale Version: VBA abändern für WENN DANN funktion
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Grüß Gott,

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  15
Hallo,

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.
(06.10.2021, 11:21)Klaus-Dieter schrieb: [ -> ]Hallo,

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.
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

Set raFund = Nothing
End Sub

Gruß Werner
Hallo Werner!

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

Set raFund = Nothing
End Sub

Gruß Werner
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

Gruß Werner
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 Exclamation



(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

Gruß Werner
Kurze Frage noch.

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 17



(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  Exclamation
Hallo,

so:
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
        Else
            MsgBox "Der Artikel " & .Cells(i, "D") & " aus Zeile " & i & " wurde nicht gefunden."
        End If
    Next i
End With
End Sub

Gruß Werner
Top!!!!
Vielen Dank


(06.10.2021, 16:24)Werner.M schrieb: [ -> ]Hallo,

so:
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
        Else
            MsgBox "Der Artikel " & .Cells(i, "D") & " aus Zeile " & i & " wurde nicht gefunden."
        End If
    Next i
End With
End Sub

Gruß Werner