對於陣列上的每個循環返回每個唯一字符串的計數

Question

我想實現的是返回列中唯一值（字符串）的列表。將該列表放入數組中，然後將值列表粘貼到新表中，例如A列中。 然後爲每個數組元素計算它發生原始列表的次數，並返回新工作表中列B中的頻率計數反對其獨特的字符串。

這是我的代碼到目前爲止。

Sub UniqueList() 
Dim rListPaste As Range 
Dim causeList As Range 
Dim iReply As Integer 
Dim element As Variant 

On Error Resume Next 

Set rListPaste = Application.InputBox _ 
(Prompt:="Please select the destination cell", Type:=8) 

    If rListPaste Is Nothing Then 
     iReply = MsgBox("No range nominated," _ 
      & " terminate", vbYesNo + vbQuestion) 
     If iReply = vbYes Then Exit Sub 
    End If 


causeList = Range("E1", Range("E65536").End(xlUp)) 
Range("causeList").AdvancedFilter Action:=xlFilterCopy, Unique:=True 
Range("causeList").AdvancedFilter CopyToRange:=causeList.Cells(1, 1) 

element = 0 
For Each element In causeList 
    element = element + 1 
Next element 
End 


End Sub 

Answer 1

有多種方式來實現你在找什麼：

1.使用數據透視表：

只需插入數據透視表爲您的數據範圍。刪除你感興趣的字段（列名），在行字段和數據字段中。您會看到唯一項目列表和旁邊的計數。如果數據發生變化，則需要刷新數據透視表

2.創建唯一值的列表，並添加COUNTIF公式 首先，應用高級過濾器，您的列（數據 - >過濾器 - >高級）。在這裏，選擇「複製到其他位置」，選擇您的數據範圍（如「列表範圍」），您的目的地（「複製到」），並選中「唯一值」。 現在使用該唯一列表，在下一列中添加一個COUNTIF公式。

3. VBA

下面的代碼會輸出唯一值及其頻率的列表。您需要添加對「Microsoft Scripting Library」的引用，因爲它使用Dictionary對象：

 
Sub CountUnique(rngInput As Range, rngTarget As Range) 

    Dim d As New Dictionary 
    Dim varCell As Variant 
    Dim varKey As Variant 
    Dim rngOut As Range 
    For Each varCell In rngInput 
     If Not d.Exists(varCell.Value) Then 
      d.Add varCell.Value, 0& 
     End If 
     d(varCell.Value) = d(varCell.Value) + 1 
    Next 

    Set rngOut = rngTarget(1, 1) 
    For Each varKey In d.Keys 
     rngOut.Value = varKey 
     rngOut.Offset(, 1) = d(varKey) 
     Set rngOut = rngOut.Offset(1) 
    Next 

End Sub