Często e Excelu potrzebujemy zrobić porównanie dwóch kolumn i zamiast ręcznie szukać każdej pozycji można zastosować Makro.
Więc do Dzieła
Porównanie 2 kolumn w arkuszu i podświetlenie pasujących wartości.
Otwieramy arkusz excel-a, klikamy klawisz Makro
w zakładce Deweloper .
Moza posłużyć się kombinacja klawiszy ALT + F11 lub jak ktoś niema zakładki Deweloper może sobie ja włączyć
Klikamy PLIK > OPCJE >Dostosowanie wstążki i zaznaczamy „ptaszka” Przy DEWELOPER
Klikamy więc Makro i wpisujemy nazwę naszego makra nr:porównanie ( ja wpisuje bez polskich znaków )
Otworzy się następne okienko gdzie wklejamy nasz kod ( ten poniżej ) poprawimy to co zaznaczone aby dopasować do swoich potrzeb zamykamy i
UWAGA
PAMIETAJ o zmianie parametrów pod swoje potrzeby .-
– Wybieramy nazwę arkusza
-Które kolumny ma porównać ( kolumna A to 1 B to 2 itd..
-Możesz wybrać kolor zaznaczenia
A oto zbawienny kod makro który porówna nam dwie kolumny i zaznaczy powtarzające się fragmenty
Sub POROWNANIE()
Dim c1 As Integer, c2 As Integer
Dim i As Long, k As Long, count As Long
Dim lr1 As Long, lr2 As Long
Dim cf1 As String, cf2 As String
Dim WS As Worksheet
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Wpisz nazwę Arkusza
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Set WS = Worksheets("Arkusz2") ' możena tez podać numer zakładki np: Set WS = Worksheets(2)
Application.ScreenUpdating = False
Application.StatusBar = "Chwila przgotowuje raport raport..."
Application.DisplayAlerts = True
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Wpisz swoje numer kolumny które chcesz porównać w C1 oraz C2 oraz (1 to kolumna A 2 to kolumna B itd.)
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
c1 = 1
c2 = 3
With WS.UsedRange
lr1 = .Rows.count
End With
For i = 2 To lr1
For k = 2 To lr1
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = WS.Cells(i, c1).FormulaLocal
cf2 = WS.Cells(k, c2).FormulaLocal
On Error GoTo 0
If cf1 = cf2 Then
count = count + 1
'Możesz zmienic kolor zamiast 46 wpisz wartość od 0-255
WS.Cells(i, c1).Interior.ColorIndex = 46
WS.Cells(i, c1).Select
Selection.Font.Bold = True
Exit For
End If
Next k
Next i
Application.StatusBar = "Przygotowuje raport......"
'Columns("A:IV").ColumnWidth = 10
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox count & " komórki zawierają te same wartości! ", vbInformation, _
"Porównano kolumnę " & c1 & " z kolumną " & c2
End Sub
I to chyba wszystko
TH team 🙂 Vertical Horizons
