Witam
Mam makro które zlicza duplikaty i zapisuje wynik w nowym skoroszycie. Makroskala poprawnie do chwili ożycia filtra (Autofilter).
Jak zmodyfikować makro by filtrowało wynik zgodnie z Auto filtrem?
Sub Duplikaty_kuma() 'http://www.excelforum.pl/topics3/makro-liczace-duplikaty-przerobka-vt48615.htm?sid=e07ccf9514e3b9991af6934c0adc0c7a#272559
Dim dic As Object
Dim MyArr() As Variant, klucz As Variant
Dim i As Long, licznik As Long
With Worksheets(1)
MyArr = Application.Transpose(.Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value)
Application.ScreenUpdating = False
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(MyArr)
klucz = MyArr(i)
If klucz <> "" Then
If dic.exists(klucz) Then
dic.Item(klucz) = dic.Item(klucz) + 1
Else
dic.Add klucz, 1
End If
End If
Next i
If dic.Count Then
ReDim MyArr(1 To dic.Count, 1 To 2)
For Each klucz In dic.Keys
If dic.Item(klucz) > 1 Then
licznik = licznik + 1
MyArr(licznik, 1) = klucz 'zduplikowana wartosc
MyArr(licznik, 2) = dic.Item(klucz) 'ilosc wystapien wartosci zduplikowanych
End If
Next
With ThisWorkbook.Sheets(2).Range("A1")
.CurrentRegion.ClearContents
If licznik Then .Resize(licznik, 2).Value = MyArr
End With
End If
End With
Set dic = Nothing
Application.ScreenUpdating = True
End Sub |
wstecz 1 dalej
otwarty rozpoczął: JAM
postów: 3
