Excel 匹配子字符串并计算它们的出现次数以生成一个简短的句子_Excel_Vba_Excel Formula_String Matching

Excel 匹配子字符串并计算它们的出现次数以生成一个简短的句子

excel vba excel-formula

Excel 匹配子字符串并计算它们的出现次数以生成一个简短的句子,excel,vba,excel-formula,string-matching,Excel,Vba,Excel Formula,String Matching,我有以下Excel数据： A B C + ------------ ------------- ----------------- 1 | WORD WORD MIX MATCH TEXT RESULT 2 | somewordsome emsomordsowe ... 3 | anotherword somethingelse ... 4 | ...

我有以下Excel数据：

     A              B              C
  + ------------   -------------   -----------------
1 | WORD           WORD MIX        MATCH TEXT RESULT
2 | somewordsome   emsomordsowe    ...
3 | anotherword    somethingelse   ...
4 | ...            ...             ...

我想：

首先，通过将
```
A2
```
单元格中的字符串拆分为2到12个相邻字符的唯一组（注意：2是组成一个组的最小字符数；12是单词的字符总数），得到一个数组，例如
```
ArrayOfGroups
```
，即2个字符的组将是
```
so
```
，
```
om
```
，
```
me
```
，
```
ew
```
、
```
wo
```
、
```
或
```
、
```
rd
```
、
```
ds
```
（注意：最后一个
```
so
```
、
```
om
```
和
```
me
```
组因重复而被排除在外）；3个字符组为
```
som
```
，
```
ome
```
，
```
mew
```
，
```
ewo
```
，
```
wor
```
，
```
ord
```
，
```
rds
```
，
```
dso
```
（最后一个
```
som
```
和
```
ome
```
除外）；4个字符组将是
```
some
```
，
```
omew
```
，
```
mewo
```
，
```
ewor
```
，
```
word
```
，
```
ords
```
，
```
rdso
```
，
```
dsom
```
。。。依此类推，直到完整的字符串
```
somewordsome
```
然后，迭代上述
```
ArrayOfGroups
```
以检查其每个元素是否是
```
B2
```
单元格的子字符串，并返回一个新数组，例如
```
ArrayOfMatches
```
，其中包含所有元素（字符“组名”）它们是
```
B2
```
的子字符串以及在
```
B2
```
中找到的出现次数
最后，在
```
C2
```
单元格中输出一个使用
```
ArrayOfMatches
```
数据构建的句子，该数据表示如下内容：
2个匹配项用于
so
，1个匹配项用于
som
和
rd

也许还有其他更好的方法来计算上面的句子，这是我们想要的最终结果。也许我需要使用一个用户定义的函数。。。但我没能做到

有人能提供帮助吗？

可以试试这样的方法

对代码进行编辑，以避免多次找到同一子字符串

Sub test2()
Dim Xstr As String, Ystr As String
Xstr = "somewordsome"
Ystr = "emsomordsowe"
MsgBox Xmatch2(Xstr, Ystr)
End Sub
Function Xmatch2(Xstr As String, Ystr As String) As String
Dim XSubStr As String, YSubStr As String
Dim xLn As Integer, yLn As Integer
Dim XArr As Variant, LnSubStr As Integer
Dim Rslt As String, Cnt As Integer
Dim Xrr() As Variant, Xcnt As Integer, Chk As Boolean
Rslt = "'"

xLn = Len(Xstr)
yLn = Len(Ystr)

    For LnSubStr = 2 To xLn        'length of substring
    Xcnt = 0
    ReDim XArr(1 To 1)
         For Y = 1 To xLn
         XSubStr = ""
         Xcnt = Xcnt + 1
         ReDim Preserve XArr(1 To Xcnt)
         If Y + LnSubStr - 1 <= xLn Then XSubStr = Mid(Xstr, Y, LnSubStr)
         XArr(Xcnt) = XSubStr
            Chk = False
            For i = 1 To Xcnt - 1
                If XArr(i) = XSubStr Then
                Chk = True
                Exit For
                End If
            Next

            If XSubStr <> "" And Chk = False Then
                Cnt = 0
                ReDim Preserve XArr(1 To Xcnt)
                For Z = 1 To yLn
                YSubStr = ""
                If Z + LnSubStr - 1 <= yLn Then YSubStr = Mid(Ystr, Z, LnSubStr)
                If YSubStr = XSubStr Then Cnt = Cnt + 1
                Next
            If Cnt > 0 Then Rslt = Rslt & Cnt & " Matches for " & XSubStr & ","
            End If
         Next
    Next

Debug.Print Rslt
Xmatch2 = Rslt
End Function

子测试2（）
Dim Xstr作为字符串，Ystr作为字符串
Xstr=“somewordsome”
Ystr=“emsomordsowe”
MsgBox Xmatch2（Xstr、Ystr）
端接头
函数Xmatch2（Xstr作为字符串，Ystr作为字符串）作为字符串
Dim XSubStr作为字符串，YSubStr作为字符串
Dim xLn为整数，yLn为整数
Dim XArr作为变量，LNSSUBSTR作为整数
Dim Rslt作为字符串，Cnt作为整数
Dim Xrr（）作为变量，Xcnt作为整数，Chk作为布尔值
Rslt=“””
xLn=Len（Xstr）
yLn=Len（Ystr）
对于LNSSUBSTR=2到xLn'的子串长度
Xcnt=0
ReDim XArr（1对1）
对于Y=1到xLn
XSubStr=“”
Xcnt=Xcnt+1
ReDim保留XArr（1到Xcnt）
如果Y+LnSubStr-1帮助我们帮助您，请发布您当前的代码。您遇到问题的流程的第一个特定部分是什么？你厌倦了解决什么问题？你遇到了什么问题？我几乎尝试了所有使用Excel基本功能的方法，包括它们的组合，还搜索了一些UDF脚本，但没有成功，从24小时前就开始了（不停！）IBTW为什么投反对票？！这个和这个：这应该给你一个开始…顺便说一句，yLn=Len（Xstr）
应该是yLn=Len（Ystr）
谢谢你指出。它工作正常，因为在所有测试中，我们使用了长度相等的字符串。编辑。并更正。