Suche innerhalb der Tabelle1
15.01.2009 14:20:00
Wolfgang
den nachstehenden Code hat mir Sepp zur Verfügung gestellt. Er läuft auch wunderbar und bewirkt, dass doppelte Datensätze im Vergleich von Tabelle1 zu Tabelle 2 mit entspr. Hyperlink versehen werden. Wie müßte ich den Code verändern, wenn ich nun einen Abgleich nur innerhalb der Tabelle1 vornehmen möchte? Noch idealer wäre, wenn die Suche zwischen Tabelle1 und 2 sowie umgekehrt und dann in Tabelle1 und Tabelle2 getrennt (also Doppelte innerhalb der jeweiligen Tabelle) gestaltet werden könnte.
Danke schon jetzt für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Sub compareRanges()
Dim objWsA As Worksheet, objWsB As Worksheet
Dim rngA As Range, rngB As Range
Dim strA As String, strB As String
Dim lngRow As Long, lngIndex As Long
Dim varRes As Variant
Set objWsA = Sheets("Tabelle1") 'Anpassen
Set objWsB = Sheets("Tabelle2") 'Anpassen
Set rngA = objWsA.Range("D2:E" & Application.Max(objWsA.Cells(Rows.Count, 5).End(xlUp).Row, _
_
2))
Set rngB = objWsB.Range("D2:E" & Application.Max(objWsB.Cells(Rows.Count, 5).End(xlUp).Row, _
_
2))
For lngIndex = 1 To rngB.Columns.Count
strB = strB + rngB.Parent.Name & "!" & rngB.Columns(lngIndex).Address & "&"
Next
strB = Left(strB, Len(strB) - 1)
For lngRow = 1 To rngA.Rows.Count
strA = ""
For lngIndex = 1 To rngA.Columns.Count
strA = strA + rngA.Parent.Name & "!" & rngA.Cells(lngRow, lngIndex).Address & "&"
Next
strA = Left(strA, Len(strA) - 1)
varRes = Evaluate("MATCH(" & strA & "," & strB & ",0)")
If IsNumeric(varRes) Then
rngA.Parent.Hyperlinks.Add _
Anchor:=rngA.Cells(lngRow, rngA.Columns.Count).Offset(0, 2), _
Address:="", _
SubAddress:=rngB.Parent.Name & "!" & rngB.Rows(varRes).Address, _
TextToDisplay:="Doppelt!"
End If
Next
Set objWsA = Nothing
Set objWsB = Nothing
Set rngA = Nothing
Set rngB = Nothing
End Sub