string拆分并在Excel中计数
我在Excel中有以下列K ：
K 2 Apps - 3 Appointed CA - Apps - Assist - Appointed NA - EOD Efficiency 4 Appointed CA - 5 Appointed CA -
我想分割-并计算string中特定单词的出现次数。
我试了下面的公式，它分割我的string，并返回一切LEFT -
=LEFT( K2, FIND( "-", K2 ) - 2 )
但理想的产出应该是：
Apps Appointed CA Assist Appointed NA EOD Efficiency 1 1 1 1 1 1 1 1
根据以上数据。
问候，
这是一个VBAmacros
- 从所有数据中生成唯一的短语列表
- 创build包含输出短语的“标题行”
- 再次浏览原始数据，并为每个词组生成计数
正如所写，这个macros不区分大小写。 为了区分大小写，可以改变生成唯一列表的方法 – 使用Dictionary对象而不是集合。
要input这个macros（Sub）， alt-F11打开Visual Basic编辑器。 确保您的项目在“项目浏览器”窗口中突出显示。 然后，从顶部菜单中select插入/模块，然后将下面的代码粘贴到打开的窗口中。 应该很明显，在哪里进行更改以处理源数据所在位置的变化以及您想要的结果。
要使用这个macros（Sub）， alt-F8打开macros对话框。 按名称selectmacros，并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
假设结果范围从列L开始：
L2： =IF(FIND("Apps", K2, 1) <> 0, 1, "")
M2： =IF(FIND("Appointed CA", K2, 1) <> 0, 1, "")
等等
自动填充向下。
编辑：
假设所有可能的string组合，我们正在寻找提前知道，下面应该工作。 如果可能的string组合是不知道的，我会build议build立一个UDFsorting一切。
无论如何，假设琴弦是已知的，遵循与上面相同的原则：
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)), "")
根据需要增加尽可能多的string，向下自动填充。