'2这个符号中后面有不可见字符,自己先处理一下,,,
Option Explicit
Sub test()
Dim arr, dic, i, j, t
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 4 Step 3
arr = Cells(1, i).CurrentRegion.Value
For j = 1 To UBound(arr, 1)
arr(j, 2) = Replace(arr(j, 2), Space(1), vbNullString)
arr(j, 2) = Replace(arr(j, 2), "●", "短")
arr(j, 2) = Replace(arr(j, 2), "-", "长")
dic(arr(j, 2)) = arr(j, 1)
Next
Next
arr = Range("h3:h" & [h3].End(xlDown).Row)
ReDim brr(1 To UBound(arr, 1), 1 To 1)
For i = 1 To UBound(arr, 1)
arr(i, 1) = Replace(arr(i, 1), Space(1), vbNullString)
arr(i, 1) = Replace(arr(i, 1), "。", vbNullString)
t = Split(arr(i, 1), ",")
For j = 0 To UBound(t)
If Len(t(j)) Then
If dic.exists(t(j)) Then
brr(i, 1) = brr(i, 1) & "," & dic(t(j))
Else
brr(i, 1) = brr(i, 1) & "," & "?"
End If
End If
Next
If Len(brr(i, 1)) Then brr(i, 1) = Mid(brr(i, 1), 2)
Next
[i3].Resize(UBound(brr, 1)) = brr
End Sub |