makro ile a sutunundaki mükerrer kodları bulup miktarını b ye yazdırma

[jambow]

merhaba
a sutunundaki kodların adet sayısını bularak b sutununa yazdırma

bunu makro ile yapabilirmiyiz örnek ekte

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u kullanabilirsiniz.
.

[FONT="Arial Narrow"][B]Sub TOPARLA()[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For satır = [A65536].End(3).Row To 2 Step -1
If Cells(satır, 2) = "" Then
    hedef = WorksheetFunction.Match(Cells(satır, 1), Range("A:A"), 0)
    If Cells(hedef, 2) = "" Then Cells(hedef, 2) = 1
    Cells(hedef, 2) = Cells(hedef, 2) + 1
    Range("A" & satır & ":B" & satır).Delete Shift:=xlUp
End If
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı...", vbInformation, "..:: jambow ::.."
[B]End Sub[/B][/FONT]