Třeba
Sub Porovnej()
Dim BlkA As Range, BlkB As Range
Dim CllA As Range, CllB As Range
Dim frstAddr As String
Dim shoda As Integer
' definovani bloku bunek
Set BlkA = Range("BJ25:BK34")
Set BlkB = Range("A9:B106")
shoda = 0 ' pocet shod
Application.ScreenUpdating = False
' prochazet BlkA
For Each CllA In BlkA.Cells
' prohledavat BlkB
With BlkB
Set CllB = .Find(CllA.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not CllB Is Nothing And Not IsEmpty(CllB) Then ' pri shode
frstAddr = CllB.Address
Do
CllB.ClearContents
shoda = shoda + 1
GoTo dalsi ' skoc na dalsi hodnotu v bloku A
Set CllB = .FindNext(CllB)
Loop While CllB.Address <> frstAddr
End If
dalsi:
End With
Next CllA
Application.ScreenUpdating = True
MsgBox " Uff, nasel jsem " & shoda & " shod a ty smazal.", vbInformation
' odstranit objektove promenne
Set CllB = Nothing
Set CllA = Nothing
Set BlkB = Nothing
Set BlkA = Nothing
End Subcitovat
Sub Porovnej()
Dim BlkA As Range, BlkB As Range
Dim CllA As Range, CllB As Range
Dim frstAddr As String
Dim shoda As Integer
' definovani bloku bunek
Set BlkA = Range("BJ25:BK34")
Set BlkB = Range("A9:B106")
shoda = 0 ' pocet shod
Application.ScreenUpdating = False
' prochazet BlkA
For Each CllA In BlkA.Cells
' prohledavat BlkB
With BlkB
Set CllB = .Find(CllA.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not CllB Is Nothing And Not IsEmpty(CllB) Then ' pri shode
frstAddr = CllB.Address
Do
CllB.ClearContents
shoda = shoda + 1
GoTo dalsi ' skoc na dalsi hodnotu v bloku A
Set CllB = .FindNext(CllB)
Loop While CllB.Address <> frstAddr
End If
dalsi:
End With
Next CllA
Application.ScreenUpdating = True
MsgBox " Uff, nasel jsem " & shoda & " shod a ty smazal.", vbInformation
' odstranit objektove promenne
Set CllB = Nothing
Set CllA = Nothing
Set BlkB = Nothing
Set BlkA = Nothing
End Subcitovat
21264_test.zip
RSS nejnovější články