AW: Range vergleichen
14.10.2013 15:54:30
fcs
Hallo Manuel,
hier eine Lösung die stumpf Zelle für Zelle in Schleifen vergleich.
Wenn die zu vergleichenden Zellbereiche sehr groß sind, dann macht es Sinn, die Bereichsdaten in Daten-Array einzulesen und zu vergleichen, um das Makro zu beschleunigen.
mfg
Franz
Sub BereicheVergleichen()
Dim rng(1 To 3) As Range
Dim strMsg As String, strGefunden As String, strSep As String
Dim Zelle As Range
With ActiveSheet
Set rng(1) = .Range("A2:A10")
Set rng(2) = .Range("C2:C100")
Set rng(3) = .Range("F2:F30")
End With
strSep = ", " 'Trennzeichen Fundstellen
For Each Zelle In rng(1)
strMsg = ""
strGefunden = fncCompareRange(varWert:=Zelle.Value, rngFind:=rng(2))
If strGefunden "" Then
strMsg = IIf(strMsg = "", strGefunden, strMsg & strSep & strGefunden)
End If
strGefunden = fncCompareRange(varWert:=Zelle.Value, rngFind:=rng(3))
If strGefunden "" Then
strMsg = IIf(strMsg = "", strGefunden, strMsg & strSep & strGefunden)
End If
strMsg = "Wert " & Zelle.Value & " in " & Zelle.Address _
& " gefunden in Zellen:" & vbLf & vbLf & strMsg
If MsgBox(strMsg, vbInformation + vbRetryCancel, _
"Zellbereiche vergleichen") = vbCancel Then Exit For
Next
End Sub
Function fncCompareRange(varWert, rngFind As Range, _
Optional strSep As String = ", ") As String
Dim strFound As String
Dim Zelle As Range
For Each Zelle In rngFind
If Zelle.Value = varWert Then
If strFound = "" Then
strFound = Zelle.Address
Else
strFound = Zelle.Address
End If
End If
Next
fncCompareRange = strFound
End Function