Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

Forumthread: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

14.08.2025 10:17:57

Andreas

Guten Morgen zusammen, und schonmal Danke, dass ihr meine Frage Euch anschaut.

ich bastle an einer Prüfabfrage und möchte eine weitere Bedingung einfügen, die sich auf ein anderes Tabellenblatt bezieht. Im Moment sieht mein Code wie folgt aus:



For j = 1 To 197

    For i = 6 To 400

    If Worksheets("Bericht1").Cells(i, 30) = "" Then

    If InStr(1, Worksheets("Bericht1").Cells(i, 3), Worksheets("Firmenstammdaten").Cells(j, 3).Value, vbTextCompare) Then

    Worksheets("Bericht1").Cells(i, 30).Value = Worksheets("Firmenstammdaten").Cells(j, 2).Value

    Worksheets("Bericht1").Cells(i, 31).Value = "3"

    End If

    End If

    Next i

Next j

So weit so gut. Der Code macht erstmal das was ich erwarte.
Ich habe eine weiteres Tabellenblatt "FirmenstammdatenIDanzahl". Dieses besteht aus 3 Spalten: A: Firmen-ID, B: Firmen-Name, C: Zählwert (Wie oft die Firmen-ID im Tabellenblatt "Bericht 1) vorkommt.
Ich möchte den o.g. Code nur nach folgender zusätzlicher Prüfbedingung für den i-Schritt ausführen lassen:
Wenn die Firmen-ID in Worksheets("Bericht1").Cells(i, 2) kleiner als 4 mal im Worksheet("FirmenstammdatenIDanzahl"), Spalte C vorkommt.
Andernfalls soll für den i-Schritt nichts unternommen werden (Zelle i, 30 und i,31 sollen leer bleiben).

Ich denke es ist eine weitere Bedingung zum schon bestehenden Prüfung If Worksheets("Bericht1").Cells(i, 30) = ""
Ich komm mit nicht damit zurecht, wie ich mit so einem Art S-Verweis die zusätzliche Bedingung formulieren soll.

Erst einmal vielen Dank, dass Du bis hierhin gelesen hast und Dich offensichtlich durch meine chaotischen Gedanken gekämpft hast. Ich hoffe die Beschreibung ist nachvollziehbar.

Ich würde mich ganz sehr über einen Lösungsansatz freuen. Diese Prüfbedingung ist der letzte Schritt, um meinen für mich ansonsten doch komplexen (und nur mit Hilfe in diesem Forum überhaupt entstandenen) Gesamt-Code zu vervollständigen.

Ich danke ganz sehr für Euer Engagement und die uneigennützige Unterstützung von Euch in diesem Forum.

Viele Grüße

Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

14.08.2025 11:13:34

GerdL

Moin Andreas!

Dim B As Worksheet, Fd As Worksheet



Set B = Worksheets("Bericht1")

Set Fd = Worksheets("Firmenstammdaten")



For j = 1 To 197

    For i = 6 To 400

        If WorksheetFunction.CountIf(Fd.Columns("C"), B.Cells(i, 2))  4 Then

            If B.Cells(i, 30) = "" Then

                If InStr(1, B.Cells(i, 3), Fd.Cells(j, 3).Value, vbTextCompare) Then

                    B.Cells(i, 30).Value = Fd.Cells(j, 2).Value

                    B.Cells(i, 31).Value = "3"

                End If

            End If

        End If

    Next i

Next j

Gruß Gerd

AW: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

14.08.2025 12:33:24

Yal

Hallo Andreas,

ich habe die Lösung von Gerd gebraucht, um deine Frage zu verstehen. Die Antwort von Gerd ist schlüssig: Du brauchst diese separate Zählung nicht.

Was mich aber wundert ist, dass Du nicht die Zeile von "Bericht1" zuerst in der Schleife gehst, was eher üblich ist. Die innere For-Schleife wird mit einem Exit For beschleunigt.
Hier ein Beispiel dafür

Sub test()

Dim Q As Range 'Quell-Zeile

Dim Z As Range 'Ziel-Zeile

    

    With Worksheets("Firmenstammdaten")

        For Each Z In Worksheets("Bericht1").Range("6:400")

            If WorksheetFunction.CountIf(.Columns("C"), Z.Cells(2))  4 Then

                If Z.Cells(30).Value = "" Then '30te Zelle in der gegeben Zeile, also Cells(i,30)

                    For Each Q In .Range("1:197")

                        If InStr(1, Z.Cells(3), Q.Cells(3).Value, vbTextCompare) Then

                            Z.Cells(30).Value = Q.Cells(2).Value

                            Z.Cells(31).Value = "3"

                            Exit For

                        End If

                    Next

                End If

            End If

        Next

    End With

End Sub

Ich habe dabei die Verwendung von Objekte mit For Each ausgenutzt: es wird stets Zelle in je einer Zeile gelesen. Wenn man in dem For diese Zeilen 2 Objektvariablen Q und Z übergibt, kann man den Code "leichter" (es ist Empfindungsache ;-) haben.
Auch die Verwendung der With braucht zuerst ein Bischen Übung (alles was mit einem Punkt anfängt, bezieht sich auf dem With).
Noch eine letzte: saubere Einrücken ist pflicht!

VG
Yal

AW: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

15.08.2025 09:45:37

Andreas

Lieber Gerd,
ganz, ganz herzlichen Dank für deine Hilfe! Mit Deiner Unterstützung und der von YAL habe ich es hinbekommen. Besonderer Dank gilt Dir und Euch, für die Mühe ersteinmal zu verstehen was ich vor hatte um dann noch eine passende Idee zu entwickeln. Die Logik, die Zählung nicht in einem separaten Tabellenblatt durchzuführen war Gold wert. Weil die Rechendauer doch erheblich war. habe ich mich entschieden, zunächst in einer Hilfspalte für jede Zeile die Anzahl (Zählenwenn-Formel) auszugeben und dann den Code mit einer zusätzlichen Prüfbedingung zu ergänzen. Das sieht dann wie folgt aus:



For j = 1 To 197

    For i = 6 To 400

        If Worksheets("Bericht1").Cells(i, 31) = "" _

        And Worksheets("Bericht1").Cells(i, 26)  4 Then

            If InStr(1, Worksheets("Bericht1").Cells(i, 3), Worksheets("Firmenstammdaten").Cells(j, 3).Value, vbTextCompare) Then

                Worksheets("Bericht1").Cells(i, 30).Value = Worksheets("Firmenstammdaten").Cells(j, 2).Value

                Worksheets("Bericht1").Cells(i, 31).Value = "3"

            End If

        End If

    Next i

Next j

Im nachhinein total simpel, aber es hat diesen Lösungsansatz von Dir gebraucht. DANKESCHÖN!

Viele Grüße und ein schönes Wochenende schoneinmal.

AW: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

15.08.2025 12:35:02

Yal

Hallo Andreas,

ich gehe davon aus, dass die Einträge in Firmenstammdaten nur einmal vorkommt, sodass wenn einen Instr zugeschlagen hat, keinen weitern Treffer zu erwarten sind.
Du könntest daher mit einem Exit For ca. 50% aller Checks sparen.
Es setzt aber voraus, dass die äussere Schleife über die Bericht geht und die innere über die Stammdaten.

Aktuell ist es bei Dir umgekehrt und Du prüfst für jede der 400 Berichtszeile 197 mal, ob der Eintrag weniger als 4 mal vorkommt...

Füge folgende Code vor und nach der Bearbeitung in sowohl meine und deine Lösung und schaue welche Zeitunterschied es macht:

Dim T 

    T = Timer

    ... hier kommt der Code, den es zu challengen gilt

    MsgBox Timer - T 'Laufzeit in Sekunden

Und weil die Änderung so einfach ist, hier die Korrektur:

Dim B As Worksheet, Fd As Worksheet

Dim T 

    T = Timer

    Set B = Worksheets("Bericht1")

    Set Fd = Worksheets("Firmenstammdaten")



    For i = 6 To 400

        If B.Cells(i, 30) = "" Then

            If WorksheetFunction.CountIf(Fd.Columns("C"), B.Cells(i, 2))  4 Then

                For j = 1 To 197

                    If InStr(1, B.Cells(i, 3), Fd.Cells(j, 3).Value, vbTextCompare) Then

                        B.Cells(i, 30).Value = Fd.Cells(j, 2).Value

                        B.Cells(i, 31).Value = "3"

                    End If

                Next j

            End If

        End If

    Next i

    MsgBox Timer - T 'Laufzeit in Sekunden

VG
Yal

Aarg, Fehler!

14.08.2025 12:37:30

Yal

... die Zeilen-Auflistung müssen mit ".Rows" spezifiziert, sonst geht es auf jede einzelne Zelle (".Cells" ist das Default-Eigenschaft des Objekts Range)

Sub test()

Dim Q As Range 'Quell-Zeile

Dim Z As Range 'Ziel-Zeile

    

    With Worksheets("Firmenstammdaten")

        For Each Z In Worksheets("Bericht1").Range("6:400").Rows

            If WorksheetFunction.CountIf(.Columns("C"), Z.Cells(2))  4 Then

                If Z.Cells(30).Value = "" Then '30te Zelle in der gegeben Zeile, also Cells(i,30)

                    For Each Q In .Range("1:197").Rows

                        If InStr(1, Z.Cells(3), Q.Cells(3).Value, vbTextCompare) Then

                            Z.Cells(30).Value = Q.Cells(2).Value

                            Z.Cells(31).Value = "3"

                            Exit For

                        End If

                    Next

                End If

            End If

        Next

    End With

End Sub

VG
Yal

AW: Aarg, Fehler!

15.08.2025 09:50:29

Andreas

Lieber YAL,

Dir ein ganz herzlichen Dankeschön für die Weiterentwicklung des Ansatzes von Gerd. Ich konnte mit Hilfe Eurer beiden Codes die Idee und Logik verstehen, die es brauchte um schlussendlich meine Lösung abzuschließen. Ohne Eure Hilfe hätte ich das nicht geschafft. Vielen Dank für die Mühe, Euer Wissen und die Erfahrung, die Ihr in diesem Forum allen zur Verfügung stellt.

beste Grüße und ein schönes Wochende!

Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

Forumthread: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

Forumthread: Mit VBA "S-Verweis" zusätzliche If-Bedingung einfügen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread