Porównanie dwóch kolumn podświetlenie pasujących wierszy
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