提取标识并统计次数，谢谢谢谢cidanji和飞天篮球猪、ykcbf1100老师！

lhj323323

老师：

请看如下说明


求助.rar (15 KB, 下载次数: 9)

2024-9-21 17:14 上传

点击文件名下载附件

老师如有空，请帮忙看看，先谢谢了

cnmlgb9998

是这个效果吗？



用PQ解决。很方便

cidanji

lhj323323

cidanji 发表于 2024-9-21 19:08

谢谢老师

请看下图
次数统计有误

飞天篮球猪

仅供参考：

lhj323323

飞天篮球猪 发表于 2024-9-21 20:36
仅供参考：

谢谢老师
我还是打算通过VB来解决。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.9.21
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     p = ThisWorkbook.Path & ""
   
5.     f = p & "mark.txt"
   
6.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
7.     zrr = Split(ReadUTFText(f), Chr(10))
   
8.     ReDim brr(1 To 1000, 1 To 2)
   
9.     Dim st As String
   
10.     Dim count As Integer
    
11.     On Error Resume Next
    
12.     For i = 0 To UBound(zrr)
    
13.         n = 0
    
14.         st1 = Split(zrr(i), ":")(0)
    
15.         m = m + 1
    
16.         For x = 0 To UBound(zrr)
    
17.             st = Split(zrr(x), ":")(1)
    
18.             n = n + tj(st, st1)
    
19.         Next
    
20.         brr(m, 1) = st1
    
21.         brr(m, 2) = n
    
22.     Next
    
23.     With sh
    
24.         .[a2:b1000].ClearContents
    
25.         .[a2].Resize(m, 2) = brr
    
26.     End With
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "OK！"
    
29. End Sub
    
30. 
    
31. Function ReadUTFText(ByVal fn As String) As String
    
32.     With CreateObject("ADODB.Stream")
    
33.         .Type = 2
    
34.         .Mode = 3
    
35.         .Open
    
36.         .LoadFromFile fn
    
37.         .Charset = "UTF-8"
    
38.         .Position = 2
    
39.         ReadUTFText = .ReadText
    
40.         .Close
    
41.     End With
    
42. End Function
    
43. 
    
44. Function tj(ByVal strText As String, ByVal strSearch As String) As Integer
    
45.     Dim intCount As Integer
    
46.     Dim lngIndex As Long
    
47.     Dim strNextChar As String
    
48.     intCount = 0
    
49.     lngIndex = InStr(strText, strSearch)
    
50.     Do While lngIndex > 0
    
51.         strNextChar = Mid(strText, lngIndex + Len(strSearch), 1)
    
52.         If Not IsNumeric(strNextChar) Then
    
53.             intCount = intCount + 1
    
54.         End If
    
55.         lngIndex = InStr(lngIndex + Len(strSearch), strText, strSearch)
    
56.     Loop
    
57.     tj = intCount
    
58. End Function
    

复制代码

飞天篮球猪

lhj323323 发表于 2024-9-21 21:40
谢谢老师
我还是打算通过VB来解决。

vba简单，借用3楼的加点正则就可以了，如图标注颜色部分

cidanji