- Sub Test()
- Dim Reg As Object, arr, brr, br$, i&, j&, Pat$, Pat2$, k%
- Set Reg = CreateObject("VBScript.RegExp")
- arr = Sheets("计划").[a4].CurrentRegion
- brr = Sheets("物料").[a1].CurrentRegion
- Reg.Global = True
- With Sheets("结果")
- For i = 2 To UBound(arr)
- .Cells(i + k, 1) = i - 1
- .Cells(i + k, 2) = Join(Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 7)), "/")
- Pat = arr(i, 2) & "/" & Left(arr(i, 3), 1) & ".*/" & arr(i, 4) & ".*"
- Pat2 = arr(i, 2) & arr(i, 1) & ".*?" & arr(i, 3) & "$"
- Reg.Pattern = Pat & "|" & Pat2
- For j = 2 To UBound(brr)
- '下面两句修改过
- br = Left(brr(j, 2), 1)
- If Reg.Test(brr(j, 2)) Or Reg.Test(Replace(brr(j, 2), br, br & "/")) Then
- k = k + 1
- .Cells(i + k, 2) = brr(j, 1)
- .Cells(i + k, 3) = brr(j, 2)
- .Cells(i + k, 4) = brr(j, 3)
- End If
- Next
- Next
- End With
- End Sub
复制代码 |