فایل پیوست را بررسی نمایید
کد PHP:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
On Error Resume Next
Z2 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Range("E2:F" & Z2) = ""
Dim list1 As New Collection
For I = 2 To Z2
XX = Application.CountIf(Range("A:A"), Range("A" & I))
If XX > 1 Then list1.Add Range("A" & I), CStr(Range("A" & I))
Next
For j = 1 To list1.Count
Range("E" & j + 1) = list1.Item(j)
Next
Z1 = Sheet1.Cells(Sheet1.Rows.Count, "E").End(xlUp).Row
For I = 2 To Z1
Range("F" & I) = Application.CountIf(Range("A:A"), Range("E" & I))
Next
End If
End Sub
علاقه مندی ها (Bookmarks)