AW: Datenpaare vergleichen Makro
18.05.2009 13:37:19
fcs
Hallo Volker,
hier mein VBA-Lösungsvorschlag.
Gruß
Franz
Sub Daten_nach_Ziel()
Dim ZeileZ As Long, ZeileD As Long
Dim wksDaten As Worksheet, wksZiel As Worksheet
Dim rngSuchen As Range, varSuchen1, varSuchen2
Dim strAdresse1 As String, bolGefunden As Boolean
Dim Spalte1_D As Long, Spalte2_D As Long
Dim Spalte1_Z As Long, Spalte2_Z As Long
Set wksDaten = Worksheets("Daten")
Set wksZiel = Worksheets("Ziel")
Spalte1_D = 13 'Spalte M in Datentabelle
Spalte2_D = 14 'Spalte N in Datentabelle
Spalte1_Z = 2 'Spalte B in Ziel mit Werten aus Spalte M in Datentabelle
Spalte2_Z = 3 'Spalte C in Ziel mit Werten aus Spalte N in Datentabelle
With wksDaten
'Daten in Spalte M ab Zeile 2 abarbeiten und im Zielblatt suchen
For ZeileD = 2 To .Cells(.Rows.Count, Spalte1_D).End(xlUp).Row
varSuchen1 = .Cells(ZeileD, Spalte1_D) 'Wert Spalte M
varSuchen2 = .Cells(ZeileD, Spalte2_D) 'Wert Spalte N
With wksZiel
'Wert aus Spalte M in Spalte B suchen
Set rngSuchen = .Columns(Spalte1_Z).Find(what:=varSuchen1, _
LookIn:=xlValues, lookat:=xlWhole)
If rngSuchen Is Nothing Then
bolGefunden = False
Else
'Zelladresse der 1. Fundstelle merken
strAdresse1 = rngSuchen.Address
bolGefunden = False
Do
ZeileZ = rngSuchen.Row
'Wert in Spalte C mit Wert in Spalte N vergleichen
If .Cells(ZeileZ, Spalte2_Z).Value = varSuchen2 Then
bolGefunden = True
Exit Do
End If
'Suche wiederholen
Set rngSuchen = .Columns(Spalte1_Z).FindNext(after:=rngSuchen)
Loop Until rngSuchen.Address = strAdresse1
End If
If bolGefunden = False Then 'Wertepaar wurde nicht gefunden
'Werte am Ende der Liste eintragen
ZeileZ = .Cells(.Rows.Count, Spalte1_Z).End(xlUp).Row + 1
.Cells(ZeileZ, Spalte1_Z).Value = varSuchen1
.Cells(ZeileZ, Spalte2_Z).Value = varSuchen2
End If
End With
Next
End With
End Sub