Ich bekomm's nicht hin - Tabellenabgleich
07.12.2008 20:08:00
Wolfgang
ich versuche vergebens und einigermaßen verzweifelt den nachstehenden Code abzuändern, damit die Tabelle "Gesamt" abgefragt wird, ob die Kundennummer in Spalte D entweder in den Tabellen "Grunddaten" oder "Altdaten" vorkommt, wenn ja, soll der Text aus der jeweiligen Zeile/Zelle in I:K in Grunddaten und/oder Altdaten übernommen werden. Wenn nein, weiter. Der Abgleich zwischen Gesamt und Grunddaten in Spalte D klappt zwar soweit, wie aber ausweiten auf Altdaten und wie den jeweiligen Text oder auch die Leerzelle nun übernehmen - anstatt des L in Spalte C? - Wäre für weitere Hilfestellung sehr dankbar.
Herzliche Grüße
Wolfgang
'Hier der Code, den ich unter Recherche entdeckt habe
Sub Vergleich_Makro()
Application.ScreenUpdating = False
Dim i As Long
Dim strGesamt, strAnsprech
Dim wksGesamt As Worksheet, wksGrund As Worksheet, wksAlt As Worksheet
Dim rngSuchen As Range, strAddresse As String
Dim boGefunden As Boolean
Set wksGesamt = Worksheets("Gesamt")
Set wksGrund = Worksheets("Grunddaten")
Set wksAlt = Worksheets("Altdaten")
For i = 2 To wksGrund.Cells(wksGrund.Rows.Count, 4).End(xlUp).Row 'Zeilen im Blatt Grund
strGesamt = wksGrund.Cells(i, 4).Value 'Wert Spalte D
strAnsprech = wksGrund.Cells(i, 9).Value 'Wert Spalte I
'Prüfen ob Eintrag in Grund Spalte C schon im Blatt Gesamt vorhanden ist
boGefunden = False
Set rngSuchen = wksGesamt.Columns(4).Find(what:=strGesamt, LookIn:=xlValues, _
lookat:=xlWhole)
If rngSuchen Is Nothing Then
'Prüfen ob Eintrag in Grund Spalte D schon im Blatt Altdaten vorhanden ist
Set rngSuchen = wksAlt.Columns(4).Find(what:=strGesamt, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngSuchen Is Nothing Then
strAddresse = rngSuchen.Address
'Prüfen ob für einen Eintrag im Blatt Altdaten die Spalte I übereinstimmt
Do
If strAnsprech = wksAlt.Cells(rngSuchen.Row, 9) Then
wksGrund.Cells(i, 1) = "L"
boGefunden = True
Exit Do
End If
Set rngSuchen = wksAlt.Columns(4).FindNext(After:=rngSuchen)
Loop Until rngSuchen.Address = strAddresse
End If
Else
strAddresse = rngSuchen.Address
'Prüfen ob für einen Eintrag im Blatt Gesamt die Spalte I übereinstimmt
Do
If strAnsprech = wksGesamt.Cells(rngSuchen.Row, 9) Then
wksGrund.Cells(i, 1) = "L"
boGefunden = True
Exit Do
End If
Set rngSuchen = wksGesamt.Columns(4).FindNext(After:=rngSuchen)
Loop Until rngSuchen.Address = strAddresse
End If
If boGefunden = False Then wksGrund.Cells(i, 1) = "N"
Next i
Application.ScreenUpdating = True
End Sub