Excel 处理程序

Sub test_split()
    Dim im As Variant
    Dim xx%, arrcount%
    Dim n As Long
    n = Application.CountA(ActiveSheet.Range("A:A"))
    'MsgBox n
    im = Range("A1:A" & n)
    'MsgBox UBound(im)
    arrcount = UBound(im)
    For xx = 1 To arrcount
        Checks im(xx, 1), xx
        'Wscript.sleep 500
        Range("C1") = xx & "|" & arrcount
    Next xx
    'Checks (Range("A1"))
    
End Sub

Sub Checks(str, num)

    Dim a, Arrlen%, x%, s1, ct
    Dim sok%, send%
    Dim Arrid As Variant
    Dim Arrname As Variant
    Dim Arritem As Variant
    
    Arrid = Range("H1:H5")
    Arrname = Range("I1:I5")
    
    'MsgBox Arrid(2, 1)
    
   
    Arrlen = UBound(Arrid)
    'a = Range("B1")
    'Arr = Split(a, ";")
    ct = 0
    For x = 1 To Arrlen
        a = Arrid(x, 1)
        Arritem = Split(a, ";")
        For y = 0 To UBound(Arritem)
            send = InStr(1, str, Arritem(y))
            
            If send > 0 Then
                ct = ct + 1
            Else
                ct = 0
            End If
        Next y
         'MsgBox ct & "|" & UBound(Arritem)
        '找到完全匹配项
        If ct = UBound(Arritem) + 1 Then
            Range("B" & num) = Arrname(x, 1)
            Exit For
        End If
        send = 0
        ct = 0
        'If ct > 0 Then
        'MsgBox a & "find"
        '    Range("B1") = Arrname(x, 1)
        'End If
        
        'MsgBox a & "|" & ct
        'MsgBox ct

        'Item1 = Item1 + Arrname(x, 1)
        'MsgBox Arrid(item1)
    Next x
    'Range("C1") = ct
End Sub