AW: Tabelleninhalte vergleichen-nach mehreren Spalten
09.03.2011 15:43:55
Peter
Hallo Reptil
als Makro so:
Option Explicit
'
' Ich habe hier zwei Tabellen, die Personendaten enthalten.
' Nun soll ich herausfinden, ob die Personen aus Tabelle 1 auch in Tabelle 2
' enthalten sind.
' Schlüssel hierbei sind die Spalten Vor- und Nachname, in beiden Tabellen
' die Spalten B und C.
'
' Annahmen: Spalte B = Vorname
' Spalte C = Nachname
' die Namen stehen ab Zeile 2 - Zeile 1 enthält Überschrift.
'
Public Sub Find_Methode()
Dim WkSh_1 As Worksheet ' das Tabellenblatt Tabelle1
Dim WkSh_2 As Worksheet ' das Tabellenblatt Tabelle2
Dim lLetzte As Long ' die letzte belegte Zeile in Spalte C
Dim lZeile As Long ' der For/Next Schleifen-Index
Dim rZelle As Range ' der gesuchte Wert
Dim sFundst As String ' die jeweils erste Fundstelle eines Nachnamens
Dim sSuchbegriff As String ' der Suchbegriff - hier der Nachname
Application.ScreenUpdating = False
Set WkSh_1 = ThisWorkbook.Worksheets("Tabelle1")
Set WkSh_2 = ThisWorkbook.Worksheets("Tabelle2")
lLetzte = WkSh_2.Cells(Rows.Count, 3).End(xlUp).Row
WkSh_1.Range("O2:O" & lLetzte).ClearContents
WkSh_2.Range("O2:O" & lLetzte).ClearContents
With WkSh_2.Columns(3)
For lZeile = 2 To WkSh_1.Cells(Rows.Count, 3).End(xlUp).Row
sSuchbegriff = WkSh_1.Range("C" & lZeile).Value
Set rZelle = .Find(What:=sSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues, _
After:=.Cells(.Cells.Count))
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
If WkSh_1.Range("B" & lZeile).Value = WkSh_2.Range("B" & rZelle.Row).Value Then
WkSh_1.Range("O" & lZeile).Value = "Wahr"
WkSh_2.Range("O" & lZeile).Value = "Wahr"
End If
Set rZelle = .FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address sFundst
'Else
'MsgBox "Der Begriff """ & sSuchbegriff & """ wurde nicht gefunden.", _
48, " Hinweis für " & Application.UserName
End If
Next lZeile
End With
Application.ScreenUpdating = True
Set WkSh_1 = Nothing
Set WkSh_2 = Nothing
End Sub
Gruß Peter