楼主
amulee |
Q：如何求相同位置子字符串在所有字符串中的出现次数？
A：如本例，各文本文件中含有许多字符串。取出各字符串中长度为1--文本长度的子字符串。求该子字符串在其他字符串中相同位置的出现次数。
如某字符串1234567，其子字符串12，在其他字符串的相同位置如果也为12，则计数加1。
最后再从所有提供的文本文件中求存在该子字符串的文本文件的个数。
本例中，关键是要求长度为N的字符串的各种子字符串，可采用以下算法：
- LenA = 7
- strPL = "1234567"
- ReDim arrPL(1 To (LenA + 1) * LenA / 2)
- For i = 1 To LenA
- For j = 1 To LenA + 1 - i
- k = k + 1
- arrPL(k) = Mid$(strPL$, j, i)
- Next j
- Next i
本例完整代码如下：
- Sub GetN()
- Dim arrPL() As String '所有的数字段排列
- Dim StrA$, strPL$, strTemp$, strPLTemp$
- Dim LenA As Byte, i&, j&, k&, arrJG(), arrTxt()
- Dim FName$, FS%, key, FCount%
- '定义两个字典，一个为全局字典，记录所有的情况
- '另一个为单个文件的字典，避免单个文件相同排列重复计数
- Dim dAll As Object, dOne As Object
- Set dAll = CreateObject("Scripting.Dictionary")
- Set dOne = CreateObject("Scripting.Dictionary")
- FName = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.txt")
- '文本长度
- LenA = 7
- t = Timer
- '先给出所有排列的结果
- strPL = "1234567"
- ReDim arrPL(1 To (LenA + 1) * LenA / 2)
- For i = 1 To LenA
- For j = 1 To LenA + 1 - i
- k = k + 1
- arrPL(k) = Mid$(strPL$, j, i)
- Next j
- Next i
- ReDim arrCount(1 To 1)
- k = 0
- '遍历所有Txt文件
- Do While FName <> ""
- FCount = FCount + 1
- '清空单个字典
- dOne.RemoveAll
- '打开文本文件
- FS = FreeFile
- Open ThisWorkbook.Path & Application.PathSeparator & FName For Input As #FS
- Do While Not EOF(FS)
- Line Input #FS, StrA
- '对数字进行各种排列
- For i = 1 To UBound(arrPL)
- '取出一个排列
- strPLTemp = arrPL(i)
- strTemp = StrA
- '将文本的除当前排列保留部分的其他字符替换
- For j = 1 To LenA
- If InStr(strPLTemp, j) = 0 Then Mid(strTemp, j, 1) = "*"
- Next j
- '当前字典计数
- dOne(strTemp) = dOne(strTemp) + 1
- Next i
- Loop
- '将本次结果加入全局字典
- For Each key In dOne.keys
- If dAll.exists(key) Then
- '如果全局字典中已经添加
- dAll(key) = dAll(key) & "," & Left(FName, Len(FName) - 4) & "(" & dOne(key) & ")"
- Else
- dAll(key) = Left(FName, Len(FName) - 4) & "(" & dOne(key) & ")"
- End If
- Next
- Close #FS
- FName = Dir
- Loop
- '结果处理
- For Each key In dAll.keys
- If InStr(dAll(key), ",") = 0 Then
- '如果只有一个
- dAll(key) = Split(key & ",1," & dAll(key), ",")
- Else
- '如果有多个，则重新改写
- '将数组结果写入
- dAll(key) = Split(key & "," & UBound(Split(dAll(key), ",")) + 1 & "," & dAll(key), ",")
- End If
- Next
- '结果输出
- arrTxt = dAll.items
- ReDim arrJG(UBound(arrTxt), FCount + 1)
- For i = 0 To UBound(arrJG)
- For j = 0 To UBound(arrTxt(i))
- arrJG(i, j) = arrTxt(i)(j)
- Next j
- Next i
- Range("B4").Resize(UBound(arrJG) + 1, FCount + 1) = arrJG
- MsgBox Timer - t
- End Sub
附件下载：
 如何求相同位置子字符串在所有字符串中的出现次数.rar
|