|
Du meinst etwa so?
Option Explicit
Sub test()
Dim vntItem1 As Variant
Dim vntItem2 As Variant
With Sheets("mobkzu")
'suche in Spalte InBearbeitung nach 1
For Each vntItem1 In GetValues("1", .Columns(2), xlByColumns, False)
'suche in Spalte KartenNr nach dem KartenNr Wert jender Zeile
For Each vntItem2 In GetValues(vntItem1.Offset(, 2).Value, .Columns(4), xlByColumns, False)
If vntItem1.Address <> vntItem2.Address Then
Debug.Print vntItem2, vntItem2.Address
End If
Next
Next
End With
End Sub
Function GetValues(ByVal FindWhat As Variant, ByVal Range As Excel.Range, Optional SearchOrder, Optional MatchCase) As Variant
Dim rngCell As Excel.Range
Dim dic As Object
Dim strAddr As String
Set dic = CreateObject("Scripting.Dictionary")
Set rngCell = Range.Find(FindWhat, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
If Not rngCell Is Nothing Then
strAddr = rngCell.Address
Do
dic.Add item:=rngCell, Key:="#" & CStr(dic.Count)
Set rngCell = Range.FindNext(rngCell)
Loop While rngCell.Address <> strAddr
GetValues = dic.items
Else
GetValues = Split(Empty)
End If
End Function
Wenn dies wie gewünscht funktioniert, mach eine Schleife drum. ;)
|