找到名稱爲「x」的列，並在該列中計算出現的單詞

Question

我有一個帶有標題的數據工作表。我試圖在VBA中找到帶有「type」標題的列，然後在該列中計算字符串「x」出現的次數，即計算「add」出現在標題爲「type」的列中的次數。

我知道你可以創建一個腳本字典來計算每個單詞出現的次數，我遇到了通過標題搜索來查找「type」列的問題。

到目前爲止我的代碼看起來在每一個細胞的表，但是我只是想將其限制於列「類型」：

Dim shtSheet1 As String 
Dim dict As Object 
Dim mycell As Range 

shtSheet1 = "Test" 

Set dict = CreateObject("Scripting.Dictionary") 

dict.Add "Add", 0 
dict.Add "Delete", 0 
dict.Add "Update", 0 

For Each mycell In ActiveWorkbook.Worksheets(shtSheet1).UsedRange 
If dict.Exists(ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value) Then 
     dict(ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value) = dict(ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value) + 1 
End If 
Next 

感謝您的幫助！

Answer 1

如果我理解正確的，那麼可以使用這樣的：

Sub test() 
    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary") 
    Dim shtSheet1 As Worksheet: Set shtSheet1 = Sheets("Test") 
    Dim mycell As Range, n&, z& 
    Dim Fx As Object, Key As Variant 
    Set Fx = WorksheetFunction 
    Dict.CompareMode = vbTextCompare 
    With shtSheet1 
     n = .Rows(1).Find("Type").Column 
     z = .Cells(.Rows.Count, n).End(xlUp).Row 
     For Each mycell In .Range(.Cells(2, n), Cells(z, n)) 
      If Not Dict.Exists(Fx.Trim(mycell)) Then Dict.Add Fx.Trim(mycell), 0 
     Next 
     For Each mycell In .Range(.Cells(2, n), Cells(z, n)) 
      If Dict.Exists(Fx.Trim(mycell)) Then 
       Dict(Fx.Trim(mycell)) = CLng(Dict(Fx.Trim(mycell))) + 1 
      End If 
     Next 
    End With 
    For Each Key In Dict 
     Debug.Print Key, Dict(Key) 
    Next Key 
End Sub 

與數據例如輸出低於：

更新使用worksheetfunction.countif與
變體字典

Sub test2() 
    Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary") 
    Dim shtSheet1 As Worksheet: Set shtSheet1 = Sheets("Test") 
    Dim mycell As Range, n&, Data As Range 
    Dim Fx As Object, Key As Variant 
    Set Fx = WorksheetFunction 
    Dict.CompareMode = vbTextCompare 
    With shtSheet1 
     n = .Rows(1).Find("Type").Column 
     Set Data = .Range(.Cells(2, n), Cells(.Cells(.Rows.Count, n).End(xlUp).Row, n)) 
     For Each mycell In Data 
      If Not Dict.Exists(Fx.Trim(mycell)) Then Dict.Add Fx.Trim(mycell), Fx.CountIf(Data, "*" & Fx.Trim(mycell) & "*") 
     Next 
    End With 
    For Each Key In Dict 
     Debug.Print Key, Dict(Key) 
    Next Key 
End Sub 

Answer 2

我會用這個代碼塊遍歷列標題。此外，我將使用工作表函數COUNTIF，因此您只需遍歷列標題而不是遍歷範圍中的每個單元格。

Dim shtSheet1 As String 
Dim dict As Object 
Dim myCell As Range 
Dim firstHeaderCell As Range 


shtSheet1 = "Test" 

Set dict = CreateObject("Scripting.Dictionary") 

Set firstHeaderCell = Range("A1") 

'Iterate across column headers only 
For Each myCell In Range(firstHeaderCell, _ 
         Cells(firstHeaderCell.Row, _ 
           firstHeaderCell.Column + firstHeaderCell.CurrentRegion.Columns.Count - 1)) 

    'Add it to the dictionary if it isn't there (this future proofs the code) 
    If Not dict.Exists(myCell.Value) Then 
    dict.Add myCell.Value, 0 
    End If 

    'Use worksheet function COUNTIF to count number of instances of column header value in the column 
    dict(myCell.Value) = WorksheetFunction.CountIf(Range(Cells(firstHeaderCell.Row + 1, myCell.Column), _ 
                 Cells(firstHeaderCell.CurrentRegion.Rows.Count - 1, firstHeaderCell.Column)), _ 
                myCell.Value) 

Next