Сохранение результата как массив с COUNTIF в VBA Excel

Question

Я назначая число их порядок, в котором они появляются в списке, и я сделать это с помощью функции СЧЕТЕСЛИ в первенствовать что-то вроде этого,

=COUNTIF(A$2:A2,A2) 

Number Count 
10  1 
10  2 
10  3 
11  1 
11  2 
11  3 
12  1 

Я хотел бы достичь то же самое с использованием VBA. Однако, здесь есть особенности.

• Я хочу взять переменную и вычислить функцию countif, а затем просунуть их.
• Как только переменная имеет все числа (массив), я хочу вставить их в местоположение.

Answer 1

Предполагая, что столбец A отсортирован по вашему списку выше, вы можете использовать следующее.

Dim arr(100,1) as double '100 = arbitrary number for this example 
dim n as double 

n=1 

arr(roW,0) = Cell(roW + 2, 1).value 
arr(roW,1) = n 

For roW = 1 to 100 
    IF Cell(roW + 2, 1).value = Cell(roW + 1, 1).value Then 
     n = Cell(roW + 2, 1).value 
    Else 
     n=1 
    End if 
    arr(roW,0) = Cell(roW + 2, 1).value 
    arr(roW,1) = n 
Next 

Range("C2:D102")=arr 

Answer 2

Это мое предложение.

Sub Counts() 
Dim ws As Worksheet 
Set ws = ThisWorkbook.ActiveSheet 
Dim lngLastRow As Long 
lngLastRow = ws.UsedRange.Rows.Count 
Dim Arr() As Variant 
'Taking values in column A into an array 
Arr = ws.Range("A2:A" & lngLastRow).Value 
Dim Arr2() As Variant 
'another Array for Countif results 
ReDim Arr2(lngLastRow - 2, 0) 
Dim count As Long 
Dim i As Long, j As Long 'counters 

    'counting 
    For i = LBound(Arr) To UBound(Arr) 
     count = 0 
     For j = LBound(Arr) To i 
      If Arr(j, 1) = Arr(i, 1) Then count = count + 1 
     Next 
     'filling the array with results 
     Arr2(i - 1, 0) = count 
    Next 
    'sending results back to the worksheet 
    ws.Range("B2:B" & lngLastRow).Value = Arr2 

Set ws = Nothing 
End Sub 

Answer 3

И еще один вариант,

Sub GetUniqueAndCountif() 
    Dim cUnique As Collection 
    Dim Rng As Range 
    Dim Cell As Range, nW As Range 
    Dim sh As Worksheet 
    Dim vNum As Variant 

    Set sh = ThisWorkbook.Sheets("Sheet1") 
    Set Rng = sh.Range("A2", sh.Range("A2").End(xlDown)) 
    Set cUnique = New Collection 

    On Error Resume Next 
    For Each Cell In Rng.Cells 
     cUnique.Add Cell.Value, CStr(Cell.Value) 
    Next Cell 
    On Error GoTo 0 

    For Each vNum In cUnique 
     Set nW = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) 
     nW = vNum 
     nW.Offset(, 1) = WorksheetFunction.CountIf(Rng, nW) 
    Next vNum 

End Sub 

Answer 4

Следующий код оценивает результаты в виде одной формулы массива и присваивает это к varaiable д. Вы можете адаптировать ссылки и добавить переменные объявления по мере необходимости.

Sub CountifArray() 
v = Evaluate(Replace("INDEX(COUNTIF(OFFSET(y,,,ROW(y)-MIN(ROW(y))+1),y),)", "y", "A2:A8")) 
Range("B2:B8") = v 
End Sub