Hilfe beim Such- und Zuordnungsprogramm
18.10.2021 13:24:27
Chris
ich habe folgendes Problem:
Ich habe 2 Tabellen. Eine Eingabemaske (Tabelle 2) und eine Gesamtüberischt (Tabelle 1).
In Tabelle 2 erfolgt die eigentliche Dateneingabe. Nachdem die Dateneingabe abgeschlossen ist, soll zunächst in der Gesamtübersicht (Tabelle 1) gesucht werden, um welches Produkt es sich handelt. In der Gesamtübersicht können beliebig viele Produkte enthalten sein. Nachdem das Produkt identifiziert wurde, sollen die Angaben aus Tabelle 2 diesem zugeordnet werden.
Bei leeren Zeilen soll eine Zeile weiter gerechnet werden, bis das Produkt gefunden wurde. Ist das Produkt nicht in der Gesamtübersicht enthalten, soll eine MessageBox erscheinen und darauf hinweisen.
Bei mir funktioniert es leider nur in Teilen für Produkt A. Ich weiß nicht genau, wo das Problem liegt und hoffe Ihr könnt mir bei der Lösung helfen.
Die Datei habe ich beigefügt (https://www.herber.de/bbs/user/148669.xlsm). Anbei noch der Code:
Option Explicit
Private Sub CommandButton1_Click()
Dim objSource As Worksheet, objTarget As Worksheet
Dim rngFind As Range
Dim FirstCell As String
Dim varSearch As Variant
Dim iRow As Integer
Dim fRow As Integer
iRow = 5
'Teil I: Kriterienfestlegung.
Set objSource = ThisWorkbook.Sheets("Tabelle2") ' Quelltabelle: Tabelle, in der die maßgeblichen Kriterien definiert werden (z.B. Suchbegriff).
Set objTarget = ThisWorkbook.Sheets("Tabelle1") ' Zieltabelle: Tabelle, in der gesucht werden soll.
varSearch = objSource.Cells(5, 1) 'Hier befindet sich der definierte Suchbegriff
Set rngFind = objSource.Cells(5, 1).Find(what:=varSearch, lookat:=xlWhole, LookIn:=xlValues)
'Teil II: Suchp- Zuordnungsrogramm
If Not rngFind Is Nothing Then 'Wenn es leere Zeilen in dem Berich rngFind gibt (gibt es sie nicht würde der Variablen rngFind der Wert Nothing zugewiesen).
FirstCell = rngFind.Address 'dann soll FirstCell die Adresse bzw. Zelle (z.B. A5) von rngFind als Statzeile der Suche zugewiesen werden. Die Anweisung FirstCell = rngFind.Address identifiziert von welcher Zelle die Suche gestaetet wird und deklariert dies as String.
Do
If rngFind = objTarget.Cells(iRow, 1) Then
objTarget.Range("B2") = rngFind.Row 'Zeile auslesen in der der Suchbegriff gefunden wurde.
fRow = rngFind.Row 'ausgelesene Zeile definieren.
objSource.Cells(fRow + 1, 2).Copy 'zu kopierender Inhalt. Bleibt hier unverändert, da die Daten aus einer einheitlichen Tabelle kommen, die in allen RM hinterlegt ist.
objTarget.Cells(fRow + 1, 2).PasteSpecial Paste:=xlPasteValues 'Hier wird eingefügt. Muss lfd. angepasst werden.
Application.CutCopyMode = False
End If
If rngFind objSource.Cells(5, 1) Then
iRow = iRow + 1
objSource.Range("B2") = rngFind.Row 'Zeile auslesen in der der Suchbegriff gefunden wurde.
fRow = rngFind.Row 'ausgelesene Zeile definieren.
objSource.Cells(fRow + 1, 2).Copy 'zu kopierender Inhalt. Bleibt hier unverändert, da die Daten aus einer einheitlichen Tabelle kommen, die in allen RM hinterlegt ist.
objTarget.Cells(fRow + 1, 2).PasteSpecial Paste:=xlPasteValues 'Hier wird eingefügt. Muss lfd. angepasst werden.
Application.CutCopyMode = False
End If
Loop While Not rngFind Is Nothing And FirstCell rngFind.Address
End If
End Sub