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宏

从所有数据生成唯一的短语列表
创建＆＃34;标题行＆＃34;包含输出的短语
再次浏览原始数据并生成每个短语的计数

如上所述，宏不区分大小写。为了使它区分大小写，可以改变生成唯一列表的方法 - 使用Dictionary对象而不是集合。

要输入此宏（子），alt-F11将打开Visual Basic编辑器。确保在Project Explorer窗口中突出显示您的项目。然后，从顶部菜单中选择“插入/模块”，然后将下面的代码粘贴到打开的窗口中。显而易见的是，在何处进行更改以处理源数据所在位置的变化以及结果的位置。

要使用此宏（子），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)), "")

根据需要增加任意数量的字符串，自动填充。

字符串在Excel中拆分和计数

2 个答案: