Hallo,
leider komme ich mit Chat GPT und Gemini diesmal nicht weiter.
Auf Tabelle 4 werden mehrere Informationen geschrieben, ab E2 - K. Das ganze wir noch länger und vermutlich bei AL enden.
Das funktioniert bereits und mir werden momentan sieben Zellen mit Information gefüllt.
Kommt ein neuer Datensatz hinzu, wird dies in E3 -K3 fortgesetzt, dann E4 - K4 usw.
Momentan habe ich auf Tabellenblatt 1 im Bereich D31-D39 die Möglichkeit meine Suchbegriffe einzugeben.
Meine Suche möchte ich mit einem CommandButton starten
Nun möchte ich das wenn eine Zelle in D31-D39 über einen Inhalt verfügt, das dieser in Tabelle4 in E2 - K2000 gesucht wird(2000 darf auch gerne unendlich sein).
Und wenn in einer Zeile alle Suchbegriffe gefunden wurden, sollen aus dieser Zeile (momentan) die Zellen F, I und K kopiert werden.
Diese kopierten Zellen aus Tabelle4 sollen nun der Reihe nach in Tabelle 1 beginnend ab F31 eingefügt werden.
Werden in Tabelle 4 die Suchbegriffe erneut in einer Zeile gefunden, sollen auch hier wieder die Zellen F, I und K dieser Zeile kopiert werden und
nun beginnend ab F32 eingefügt werden, usw.
Von der KI habe ich momentan das:
Private Sub CommandButton2_Click()
Dim wsNummer As Worksheet, wsArtikel As Worksheet
Dim nummerRange As Range, artikelRange As Range
Dim nummerCell As Range, artikelRow As Range
Dim i As Integer, j As Integer
Dim startRow As Integer
Dim foundAll As Boolean
Dim kopierZeile As Integer
' Setze die Arbeitsblätter
Set wsNummer = ThisWorkbook.Sheets("Nummer")
Set wsArtikel = ThisWorkbook.Sheets("Artikel")
' Definiere den Bereich für die Suchbegriffe in Tabelle 1
Set nummerRange = wsNummer.Range("D31:D39")
' Schleife über jeden Suchbegriff in Tabelle 1
For Each nummerCell In nummerRange
' Setze die Variable auf "False" für jeden neuen Suchbegriff
foundAll = False
' Durchlaufe jede Zeile in Tabelle 4
For Each artikelRow In wsArtikel.Range("E2:AL" & wsArtikel.Cells(wsArtikel.Rows.Count, "E").End(xlUp).Row).Rows
' Setze die Variable auf "True" für jede neue Zeile in Tabelle 4
foundAll = True
' Überprüfe, ob alle Suchbegriffe in der aktuellen Zeile gefunden wurden
For i = 1 To 33 ' Spalten E bis AL in Tabelle 4
If Not IsError(Application.Match(nummerCell.Value, artikelRow.Columns(i), 0)) Then
' Wert gefunden
Else
' Wert nicht gefunden
foundAll = False
Exit For ' Beende die Schleife, da ein Wert nicht gefunden wurde
End If
Next i
' Wenn alle Suchbegriffe gefunden wurden
If foundAll Then
' Kopiere die relevanten Zellen in Tabelle 1
kopierZeile = wsNummer.Cells(wsNummer.Rows.Count, "F").End(xlUp).Row + 1
wsNummer.Cells(kopierZeile, "F").Value = artikelRow.Cells(1, "F").Value
wsNummer.Cells(kopierZeile, "G").Value = artikelRow.Cells(1, "I").Value
wsNummer.Cells(kopierZeile, "H").Value = artikelRow.Cells(1, "K").Value
wsNummer.Cells(kopierZeile, "I").Value = artikelRow.Cells(1, "M").Value
wsNummer.Cells(kopierZeile, "J").Value = artikelRow.Cells(1, "O").Value
wsNummer.Cells(kopierZeile, "K").Value = artikelRow.Cells(1, "Q").Value
kopierZeile = kopierZeile + 1 ' Gehe zur nächsten Zeile in Tabelle 1
End If
Next artikelRow
Next nummerCell
End Sub
Hier passiert leider nichts. Es kommt aber auch kein Fehler.
VBA kann ich leider nur grob editieren wenn es funktioniert. Selbst programmieren kann ich es leider nicht.
Schon einmal danke im vorraus für jede Hilfe :)