با سلام
لیست کردن با VB و ثبت شمارش تعداد تکرار انجام شد ولی مرحله آخر ردبندی انجام نشد
کد PHP:
Sub UniqueCopy()
Sheet1.Columns(3).Select
Selection.Clear
Sheet1.Range("A1").Select
On Error Resume Next
With ActiveSheet
.Range("A1", .Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Sheet1.Range("c1"), Unique:=True
End With
Dim i As Integer, j As Integer, temp As Integer, rng, RNG1 As Range
Set rng = Range("A1").CurrentRegion
Set RNG1 = Range("C1").CurrentRegion
For j = 2 To RNG1.Count
T = 0
For i = 2 To rng.Count
If Range("C" & j).Value = Range("A" & i).Value Then
T = T + 1
Range("D" & j).Value = T
End If
Next i
Next j
End Sub
علاقه مندی ها (Bookmarks)