在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)), "")

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