|
▼MIMI さん:
正規表現でSubMatchesを使ってみるとかはどうでしょうね?
(にしても長いPattern・・・・)
Option Explicit
Sub 正規表現パターン逆引()
Dim ans() As Variant, tbl1 As Variant, tbl2 As Variant
Dim i As Long, j As Long
Dim myPt As String
tbl1 = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
For i = 2 To UBound(tbl1)
myPt = myPt & "|(" & Replace(Replace(tbl1(i, 1), "*", ".*"), "?", ".{1}") & ")"
Next i
myPt = Mid$(myPt, 2)
tbl2 = Worksheets("Sheet2").Range("A1").CurrentRegion.Value
ReDim Preserve ans(1 To UBound(tbl2), 1 To 1)
With CreateObject("VBScript.RegExp")
.Pattern = myPt
.Global = True
For i = 2 To UBound(tbl2)
If .test(tbl2(i, 1)) Then
With .Execute(tbl2(i, 1)).Item(0).SubMatches
For j = 1 To .Count
If Not IsEmpty(.Item(j - 1)) Then
ans(i, 1) = tbl1(j + 1, 2)
Exit For
End If
Next j
End With
End If
Next i
End With
Worksheets("Sheet2").Range("B1").Resize(UBound(ans)).Value = ans
End Sub
|
|