شمارش شرطی

[sohrabahmadi]

با سلام به اساتید گرامی .توضیحات رو تو فایل پیوست نوشتم ممنون میشم راهنمایی بفرمایید.شمارش بطوری که اسامی تکراری را 1 حساب کند.اگه کد وی بی هم لطف بفرمایین

[iranweld]

با سلام


کدهای ذیل تکراری ها را یکی در نظر میگیرد و عمل شمارش را انجام میدهد.

Sub test()

Dim list1 As New Collection

Set list1 = Nothing

Dim rng, cell As Range

Range("e1") = ""

Z1 = Cells(Rows.Count, "B").End(xlUp).Row

Set rng = Range("B1:B" & Z1)

On Error Resume Next

For Each cell In rng

if cell<>"" then

list1.Add cell, CStr(cell)

end if

Next

Range("e1") = list1.Count


End Sub 

[amir_ts]

با سلام
برای شمارش بدون تکرار میشه از فرمول آرایه ای زیر استفاده کرد:

=SUM(IFERROR(1/COUNTIF(B1:B20;B1:B20);0)) 

یا از تابع قدرتمند FREQUENCY استفاده کرد:

=SUM(IF(FREQUENCY(MATCH(B1:B20;B1:B20;0);MATCH(B1:B20;B1:B20;0))>0;1)) 

حالا چنانچه بخواهید از کد های vba استفاده کنید میتونید از روش Evaluate استفاده کنید.

[LEFT]
Sub CountUnique()
Dim result1, result2 As Integer
result1 = Application.Evaluate("=SUM(IFERROR(1/COUNTIF(b1:b20,b1:b20),0))")
result2 = Application.Evaluate("=SUM(IF(FREQUENCY(MATCH(B1:B20,B1:B20,0),MATCH(B1:B20,B1:B20,0))>0,1))")
Range("f4").Value = result1
Range("f5").Value = result2
End Sub
[/LEFT]

[sohrabahmadi]

ممنون از راهنمایی بسیار عالی تون.اگه یه شرط به این اضافه کنیم چه باید کرد ؟مثلا به اضافه شرایط بالا شرط شنارش این باشه که ستون قبلی حتماً برابر با 1 باشه .البته با وی بی لطف میکنید اگه راهنمایی بفرمایید

[iranweld]

با سلام

فقط کد خط

If cell <> "" And cell.Offset(0, -1).Value = 1 

تغییر مینماید.

چنانچه خواستید بر حسب درجه اولویت نیز افراد را مشخص کنید فایل دوم را دانلود کنید

Sub test()

Dim list1 As New Collection

Set list1 = Nothing

Dim rng, cell As Range

z1 = Cells(Rows.Count, "B").End(xlUp).Row

Range("e1:e" & z1) = ""

Set rng = Range("B1:B" & z1)

On Error Resume Next

For Each cell In rng

If cell <> "" And cell.Offset(0, -1).Value = 1 Then

list1.Add LCase(cell), CStr(LCase(cell))

End If

Next

Range("e1") = list1.Count

For i = 1 To list1.Count

Range("e" & i + 1) = list1.Item(i)

Next


End Sub