在Excel中進行字符串拆分和計數

Question

我在Excel中有以下K欄：

  K           
2 Apps -                                                            
3 Appointed CA - Apps - Assist - Appointed NA - EOD Efficiency
4 Appointed CA -
5 Appointed CA -

我想拆分為-並計算字符串中特定單詞的出現次數。

我嘗試了下面的公式，拆分我字符串，並返回一切LEFT到-

=LEFT( K2, FIND( "-", K2 ) - 2 )

但是理想的輸出應該是：

Apps      Appointed CA       Assist    Appointed NA        EOD Efficiency
1
1           1                 1           1                  1
            1
            1

根據以上數據。

問候，

Answer 1

這是一個VBA宏

• 從所有數據生成唯一的短語列表
• 創建包含輸出短語的“標題行”
• 再次遍歷原始數據並為每個短語生成計數

如所寫，宏不區分大小寫。 為了區分大小寫，可以更改使用字典對象而不是集合來生成唯一列表的方法。

要輸入此宏（子）， alt-F11打開Visual Basic編輯器。 確保您的項目在“項目瀏覽器”窗口中突出顯示。 然后，從頂部菜單中選擇“插入/模塊”，然后將下面的代碼粘貼到打開的窗口中。 很明顯，在何處進行更改以處理源數據所在的位置以及所需結果的變化。

要使用此宏（子），請按alt-F8打開宏對話框。 通過名稱選擇宏，然后選擇RUN 。

它將根據您上面的理想輸出生成結果

---

Option Explicit
Option Compare Text
Sub CountPhrases()
    Dim colP As Collection
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes() As Variant
    Dim I As Long, J As Long, K As Long
    Dim V As Variant, S As String

'Set Source and Results worksheets and ranges
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1) 'Results will start in A1 on results sheet

'Get source data and read into array
With wsSrc
    vSrc = .Range("K2", .Cells(.Rows.Count, "K").End(xlUp))
End With

'Collect unique list of phrases
Set colP = New Collection

On Error Resume Next 'duplicates will return an error
For I = 1 To UBound(vSrc, 1)
    V = Split(vSrc(I, 1), "-")
    For J = 0 To UBound(V)
        S = Trim(V(J))
        If S <> "" Then colP.Add S, CStr(S)
    Next J
Next I
On Error GoTo 0

'Dimension results array
'Row 0 will be for the column headers
ReDim vRes(0 To UBound(vSrc, 1), 1 To colP.Count)

'Populate first row of results array
For J = 1 To colP.Count
    vRes(0, J) = colP(J)
Next J

'Count the phrases
For I = 1 To UBound(vSrc, 1)
    V = Split(vSrc(I, 1), "-")
    For J = 0 To UBound(V)
        S = Trim(V(J))
        If S <> "" Then
            For K = 1 To UBound(vRes, 2)
                If S = vRes(0, K) Then _
                    vRes(I, K) = vRes(I, K) + 1
            Next K
        End If
    Next J
Next I

'write results
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .EntireColumn.AutoFit
End With

End Sub

---

Answer 2

假設結果范圍從L列開始：

L2： =IF(FIND("Apps", K2, 1) <> 0, 1, "")
M2： =IF(FIND("Appointed CA", K2, 1) <> 0, 1, "")

等等

向下自動填充。

編輯：

假設我們正在尋找的所有可能的字符串組合都已提前知道，則下面的命令應該起作用。 如果不知道可能的字符串組合，我建議您構建一個UDF以將其全部整理出來。

無論如何，假設字符串是已知的，請遵循與上述相同的原理：

L2： =IF(FIND("Apps", K2, 1) <> 0, (LEN(K2) - LEN(SUBSTITUTE(K2, "Apps", "")) / LEN(K2)), "")
M2： =IF(FIND("Appointed CA", K2, 1) <> 0, (LEN(K2) - LEN(SUBSTITUTE(K2, "Appointed CA", "")) / LEN(K2)), "")

增加任意多的字符串，向下自動填充。