把单元格拆成一维数组，并对这个数组进行匹配对应的值，并返回结果

sparrowhawk2007

先谢谢各位老师~~
已写代码：
Sub 字符串拆分匹配练习()
    Worksheets("sheet1").Select
    Dim arrzc2 As Variant, arrzc3 As Variant
    On Error Resume Next
    With Range(Cells(4, 11), Cells([a65536].End(xlUp).Row, 11))
        .Clear
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Font = "宋体"
        .Font.Size = 10
    End With


    For K = 4 To [a65536].End(xlUp).Row
    If InStr(Cells(K, 10), "/") Then
        arrzc2 = Split(Cells(K, 10), "/")
        For i = 0 To UBound(arrzc2)
    '麻烦各位老师帮补充

        Next

    Else
       Cells(K, 11).Value = Application.WorksheetFunction.VLookup(Cells(K, 10), Worksheets("sheet2").Range("B:C"), 2, 0)
    End If

    Next
End Sub

sparrowhawk2007

先谢谢大家的帮忙

蓝桥玄霜

替换的例子：

chxw68

1. Sub test()
   
2.   Dim r%, i%, m%
   
3.   Dim arr, brr, crr()
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   Set d1 = CreateObject("scripting.dictionary")
   
7.   With Worksheets("sheet2")
   
8.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
9.     arr = .Range("b2:c" & r)
   
10.     For i = 1 To UBound(arr)
    
11.       d(arr(i, 1)) = arr(i, 2)
    
12.     Next
    
13.   End With
    
14.   With Worksheets("sheet1")
    
15.     r = 7
    
16.     arr = .Range("j4:j" & r)
    
17.     For i = 1 To UBound(arr)
    
18.       brr = Split(arr(i, 1), "/")
    
19.       For j = 0 To UBound(brr)
    
20.         If d.exists(brr(j)) Then
    
21.           brr(j) = d(brr(j))
    
22.         Else
    
23.           d1(brr(j)) = "请补充"
    
24.           brr(j) = "?"
    
25.         End If
    
26.       Next
    
27.       arr(i, 1) = Join(brr, "/")
    
28.     Next
    
29.     .Range("k4").Resize(UBound(arr), UBound(arr, 2)) = arr
    
30.   End With
    
31.   With Worksheets("sheet2")
    
32.     If d1.Count > 0 Then
    
33.       r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
34.       .Cells(r + 1, 2).Resize(d1.Count, 2) = Application.Transpose(Array(d1.keys, d1.items))
    
35.     End If
    
36.   End With
    
37. End Sub
    

复制代码

chxw68

详见附件。

sparrowhawk2007

chxw68 发表于 2020-2-13 10:38
详见附件。

谢谢老师~~~

sparrowhawk2007

蓝桥玄霜 发表于 2020-2-13 10:13
替换的例子：

谢谢老师~~