VBA vergleichen Tabelle

Hallo Leute,

ich möchte folgendes erreichen:

Es gibt 2 Tabellen, in der einen Tabelle wird nach der Reihe der Wert aus Spalte "A" mit den Werten aus der Tabelle aus der Spalte "B" verglichen. Die Werte in der 2 Tabelle sind nicht gleich angeordnet wie die in der ersten. Wenn der Wert aus A gefunden wurde soll ein Wert der in der 1. Tabelle in Spalte C steht, in die 2. Tabelle in die Spalte G kopiert/eingefügt werden.
Wäre sowas möglich?! Hab mir schon die Zähe daran ausgebissen.

Hier mein Anfang, der einige Fehler enthält. Es ist auch vielleicht ein komplett falscher Ansatz.

Code:

Sub x()

Dim Zelle As Range
Dim sBeg As String
Dim selc
Dim i As Integer

Do Until i = 50
i = i + 1
sBeg = Tabelle3.Range("A" & i)
selc = Tabelle2.Range("B2:B65536")
selc.Select
If Zelle = sBeg And Tabelle3.Range("E" & i) <> "D" Then
Zelle.Select

Selection.Copy
Sheets("Zusammenfasssung").Select
Range("G" & i).Select
ActiveSheet.Paste
End If
Loop

End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 109665

Url: https://administrator.de/forum/vba-vergleichen-tabelle-109665.html

Ausgedruckt am: 02.05.2025 um 23:05 Uhr

13 Kommentare

Neuester Kommentar

Hallo Saiks1989 und willkommen im Forum!

Ist das so gemeint, dass, wenn der Wert aus zB A2 auch in der Spalte B zumindest einmal vorkommt, der Wert aus C2 in die Spalte G der zweiten Tabelle eingefügt werden soll?

Dann etwa so:

Sub Zusammenfassen()
Quelltabelle = "Tabelle1"  
Quellspalte = "C"  
Quellzeile = 2 'Quelldaten ab dieser Zeile  
Kriterienspalte = "A"  
Set Suchbereich = Worksheets(Quelltabelle).Range("B:B")  

Zieltabelle = "Tabelle2"  
Zielspalte = "G"  
Zielzeile = 2 'Eintragung ab dieser Zeile  

With Worksheets(Quelltabelle)
    Kriterium = .Cells(Quellzeile, Kriterienspalte)
    Do While Kriterium <> ""  
        If Not Suchbereich.Find(Kriterium, LookIn:=xlValues) Is Nothing Then
            Worksheets(Zieltabelle).Cells(Zielzeile, Zielspalte).Value = .Cells(Quellzeile, Quellspalte).Value
            Zielzeile = Zielzeile + 1
        End If
        Quellzeile = Quellzeile + 1
        Kriterium = .Cells(Quellzeile, Kriterienspalte)
    Loop
End With
End Sub

Grüße
bastla

P.S.: Für die Formatierung von Code siehe ...

wie währ's mit einer einfachen abfrage in access?

Es ist wichtig, dass es mit excel abläuft..

Nicht ganz. Der Suchbereich befindet sich in der 2. Tabelle. Wenn der Suchwert in der 2 Tabelle gefunden wird soll der Wert genau in die selbe Zeile neben den Suchbereich.

Hallo Saiks1989!

Wenn der Wert in der selben Zeile neben den Suchbereich (Tabelle2, Spalte B) stehen soll, dann verwende doch einfach die folgende Formel und kopiere diese nach unten:

=WENN(ISTFEHLER(SVERWEIS(B2;Tabelle1!$A$1:$C$50;3;0));"";SVERWEIS(B2;Tabelle1!$A$1:$C$50;3;0))

Falls das Ganze allerdings anders gemeint war, dann stelle bitte die Inhalte der relevanten Spalten aus den beiden Tabellen einmal etwas genauer dar ...

Grüße
bastla

Das einfachste ist, wenn ich irgendwie mittels vba die Zeilennummer rausfinden kann in der der gesuchte wert drin steht.

Hallo Saiks1989!

Na dann eben folgende Variation der Schleifenteiles:

With Worksheets(Quelltabelle)
    Kriterium = .Cells(Quellzeile, Kriterienspalte)
    Do While Kriterium <> ""  
        Set F = Suchbereich.Find(Kriterium, LookIn:=xlValues)
        If Not F Is Nothing Then
            Zeile = F.Row
            '  
            ' weitere Befehle  
            '  
        End If
        Quellzeile = Quellzeile + 1
        Kriterium = .Cells(Quellzeile, Kriterienspalte)
    Loop
End With

Grüße
bastla

So das klappt nun auch super danke.. Jetz möchte ich es gern etwas abgewandelt haben und zwar sollen nach zwei Kriterien gesucht werden.
Erst wenn diese in der gleichen Zeile gefunden werden soll der Wert in die andere Tabelle übertragen werden. Ich hab es auch schon versucht, aber
es kommt immer ein Fehler:

Sub Zusammenfassen()
Dim Spalte

Quellzeile = 2 'Quelldaten ab dieser Zeile

Set Suchbereich = Worksheets("intern").Range("B:B")
Set Suchbereich1 = Worksheets("intern").Range("C:C")

With Worksheets("Zusammenfassung")
Kriterium = Tabelle3.Range("A" & Quellzeile)
Kriterium1 = Tabelle3.Range("D" & Quellzeile)
Do While Kriterium <> ""

Set F = Suchbereich.Find(Kriterium, LookIn:=xlValues)
Set G = Suchbereich1.Find(Kriterium1, LookIn:=xlValues)

Zeile1 = G.Row

Zeile = F.Row

If Zeile1 = Zeile Then
Tabelle3.Range("G" & Quellzeile) = Worksheets("intern").Range("D" & Zeile)
End If

If Tabelle3.Range("E" & Quellzeile) = "D" Then
Tabelle3.Range("G" & Quellzeile) = ""
End If

Quellzeile = Quellzeile + 1
Kriterium = Tabelle3.Range("A" & Quellzeile)
Loop
End With
End Sub

Hallo Saiks1989!

Lässt sich

es kommt immer ein Fehler:

etwas konkretisieren?

Vorweg vielleicht gleich ein Hinweis auf eine Zeile der Art

If Not F Is Nothing Then

- damit wird der Fall abgefangen, dass die Suche erfolglos war ...

Grüße
bastla

Laufzeitfehler \'91\'.

Objektvariable oder With-Blockvariable nicht festgelegt

Das ist die Fehlermeldung.

Hallo Saiks1989!

Und für welche Zeile wird der Fehler angezeigt (wo landest Du, wenn Du "Debuggen" wählst)?

Um zumindest die Hälfte der Meldung ausschließen zu können, kannst Du die "With"- und "End With"-Zeile aus Deinem Coden entfernen - Du verwendest deren Funktionalität ohnehin nicht.

Ansonsten nochmals der Hinweis darauf, dass der Rückgabewert für das Suchergebnis (das Objekt F bzw G) auch Nothing sein kann und dies vor dem Versuch, mit F.Row bzw G.Row die Zeile der Fundstelle zu erhalten, geprüft werden sollte.

Grüße
bastla

Hallo bastla!

Ich hab nun hab nun With und End with entfernt! Es kommt kein Fehler wenn ich das mit nothing machen, aber es kommen dann auch keine Ergbnisse.
Der Debugger springt auf diese Zeile: "Zeile1 = G.Row".

Es soll einfach das selbe wie vorher gemacht werden nur es muss zwei Kriterien in einer Zeile sein. Es wenn diese zwei Kritieren in der anderen Tabelle gefunden werden soll der Wert übertragen werden...