|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 一把小刀闯天下 于 2020-2-14 08:22 编辑
'还可以简化一下的,,,
Option Explicit
Sub test()
Dim arr, brr, i, j, t1, t2
arr = [a1].CurrentRegion.Value
ReDim crr(1 To UBound(arr, 1), 1 To 1)
brr = Split(Replace([b1].Value, Space(1), vbNullString), ",")
For i = 1 To UBound(arr, 1)
For j = 0 To UBound(brr)
If InStr(arr(i, 1), brr(j)) Then t1 = t1 & "," & arr(i, 1): Exit For
Next
If j = UBound(brr) + 1 Then t2 = t2 & "," & arr(i, 1)
Next
If Len(t1) Then crr(3, 1) = Mid(t1, 2): t1 = vbNullString
If Len(t2) Then crr(5, 1) = Mid(t2, 2): t2 = vbNullString
For i = 0 To UBound(brr, 1)
For j = 1 To UBound(arr)
If InStr(arr(j, 1), brr(i)) Then t1 = t1 & "," & brr(i): Exit For
Next
If j = UBound(arr, 1) + 1 Then t2 = t2 & "," & brr(i)
Next
If Len(t1) Then crr(7, 1) = Mid(t1, 2): t1 = vbNullString
If Len(t2) Then crr(9, 1) = Mid(t2, 2)
[m1].Resize(UBound(crr, 1)) = crr
End Sub
|
评分
-
1
查看全部评分
-
|