| 
    
     |  | ▼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
 
 |  |