爲唯一文件列計算重複值

Question

我有2個qns應該在VBA代碼中執行。 1.我想計算一個特定的字符串在列中有多於40個唯一值的重複次數，這可以實現。

對於例如像蘋果，香蕉，葡萄（40個更多的唯一值）的唯一值在一列中重複，並且我想要這樣的單個字符串的計數。

Apple- 30 times repeated 
banana- 4 times repeated. 

獲取每個串的總數之後，我要與特定的標準來計算它們。

EG-數蘋果，只有當成本如果高於40種 計數的葡萄，只有當成本如果高於40

可以ANY1請在這方面的幫助，如何在VBA代碼實現這一點。

Answer 1

以下代碼將列A中的所有字符串添加到集合結構中，並在對每個唯一值進行計數時對其進行排序，並將每個唯一值和相應的和存儲在字典結構中。結果然後打印到立即窗口。希望這可以幫助。

Sub main() 


'variables 
Dim colCollection As New Collection 
Dim x, q As Variant 
Dim cellValue As String 
Dim j, i, count As Integer 
Dim numbers As New Scripting.Dictionary 'NOTE: add microsoft scripting Runtime Ref 


x = 1 'collections start at 1 

    While Worksheets("Sheet1").Cells(x, "A").Value <> "" 'while cell is not empty 
     cellValue = Worksheets("Sheet1").Cells(x, "A").Value 'store string value from cell 
     colCollection.Add (cellValue) ' add entry from cell to collection 
     x = x + 1 'increment 
    Wend 

    'Sort collection (bubbble sort) and record number of each unique item 
    For i = colCollection.count To 2 Step -1 'count down from collection 
     For j = 1 To i - 1 
      'bubble up item 
      If colCollection(j) > colCollection(j + 1) Then 
       colCollection.Add colCollection(j), After:=j + 1 
       colCollection.Remove j 
      End If 
     Next j 
     'finding count of unique item 
     If i <> colCollection.count Then 'if not at last item (can't compare 2 items when only given 1) 
      If i = 2 Then 'if at end 
       numbers.Add colCollection(i), count + 3 'add sum to dictionary with corresponding key value 
      Else 
       If StrComp(colCollection(i + 1), colCollection(i), 1) = 0 Then 'if same string 
        count = count + 1 'increment count 
       Else 
        numbers.Add colCollection(i + 1), count + 1 'add sum to dictionary with corresponding key value 
        count = 0 'reset count 
       End If 
      End If 
     End If 
    Next i 


'loop through dictionary 
For Each q In numbers.Keys 
    Debug.Print q & "- " & numbers.Item(q); " times repeated." 
Next 


End Sub