excel vba 关于字符串中连续包含多少个指定字符串的问题

excel vba 关于字符串中连续包含多少个指定字符串的问题

Public Sub B1_A1()
    Dim strA as String, strB as string, strC as String
    strB = Range("B1").Value
    strA = Range("A1").Value
    
    Dim i as Integer, m as Integer
    For i = Len(strA) To 1 step -1
        For m = 1 to Len(stra) - i + 1
            strC = mid(strA,m,i)
            if instr(strb,strC)>0 then
                Msgbox i & "个：" & strC
                Exit Sub
            End If
        Next    
    next
End Sub追问等我测试一下

你这个例子是b全包含A追答A1="abcd"，
B1="bcde"
B1="bc"
B1="cdaab"这三种情况c1分别是？追问1,3
2,2
3,2追答我不确定他们是如何实现的

Option ExplicitFunction lxjs(A As Object, B As Object) Dim k As Byte, p As Boolean, I As Byte, H As Byte For k = 1 To Len(B) If p = True Then If InStr(A, Mid(B, k, 2)) > 0 = True And Len(Mid(B, k, 2)) = 2 Then I = I + 1 p = True Else If H < I Then H = I I = 0 p = False End If Else If InStr(A, Mid(B, k, 2)) > 0 = True And Len(Mid(B, k, 2)) = 2 Then I = 1 If H = 0 Then H = 1 p = True End If End If Next k If H < I Then H = I lxjs = H + 1End FunctionOption Explicit
Function lxjs(A As Object, B As Object)
Dim k As Byte, p As Boolean, I As Byte, H As Byte
For k = 1 To Len(B)
If p = True Then
If InStr(A, Mid(B, k, 2)) > 0 = True And Len(Mid(B, k, 2)) = 2 Then
I = I + 1
p = True
Else
If H < I Then H = I
I = 0
p = False
End If
Else
If InStr(A, Mid(B, k, 2)) > 0 = True And Len(Mid(B, k, 2)) = 2 Then
I = 1
If H = 0 Then H = 1
p = True
End If
End If
Next k
If H < I Then H = I
lxjs = H + 1
End Function
这是上面的自定义函数，能够实现你所提供的问题。
你可以多找找起始数据进行验证和测试，毕竟可能还有没考虑到的地方。
如果少量数据，可以直接单元格调用函数。如果批量，可以在进行程序循环调用

这个我会写！哈哈

Sub s()
    a = [a1].Text
    b = [b1] = Text
    For i = 1 To Len(a)
        t = Mid(a, i, 1)
        If InStr(b, t) > 0 Then c = c + 1
    Next
    [c1] = c
End Sub追问klljll