Vba 部分字符串匹配然后返回值

我正在研究一种快速编码银行交易的方法。我下载了一个银行数据选项卡（表1），我想搜索描述（B列）以查找与表2 a列的部分匹配。如果找到匹配项，则返回表2 B列到表1 D列的值；以及第2页C栏至第1页E栏

表1

Column A    Column B                           Column C  Column D Column E       
11/1/17     Transfer from Account 60617829-D   276       {acct}   {location}
11/1/17     Transfer from Account 60692022-D   551.46    {acct}   {location}

第2页

Column A     Column B (acct)   Column C (location)
60617829-D   10430             03
60692022-D   10490             09

我尝试使用类似于此处描述的“查找并获取”的解决方案：

但是，以下代码将表2中的第一个值返回到表1中的所有值，但没有正确匹配它们。我认为我的错误在于，当可能不需要使用数组时，我试图使用数组，但我不知所措

Sub findAndGet()

Dim sh1, sh2 As Worksheet
Dim tempRow1, tempRow2 As Integer
Dim strList() As String
Dim name As String
Dim index As Integer

'Set sheets
Set sh1 = Sheets("list")
Set sh2 = Sheets("search")

'Set the start row of Sheet1
tempRow1 = 1

'Loop all row from starRow until blank of column A in Sheet1
Do While sh1.Range("A" & tempRow1) <> ""

    'Get name
    name = sh1.Range("B" & tempRow1)

    'Split by space
    strList = Split(Trim(name), " ")

    'Set the start row of Sheet2
    tempRow2 = 1

    'Reset flag
    isFound = False

    'Loop all row from startRow until blank of column A in Sheet2
    Do While sh2.Range("A" & tempRow2) <> ""

        For index = LBound(strList) To UBound(strList)

            'If part of name is found.
            If InStr(UCase(sh2.Range("A" & tempRow2)), UCase(strList(index))) > 0 Then

                'Set true to search flag
                isFound = True

                'exit do loop
                Exit Do

            End If

        Next index

        'Increase row
        tempRow2 = tempRow2 + 1

    Loop

    'If record is found, set output
    If isFound Then

        'set account
        sh1.Range("D" & tempRow1) = sh2.Range("B" & tempRow2)

        'set location
        sh1.Range("E" & tempRow1) = sh2.Range("C" & tempRow2)

    End If

    'Increase row
    tempRow1 = tempRow1 + 1

  Loop
End Sub

Sub findAndGet（）
尺寸sh1、sh2作为工作表
Dim tempRow1，tempRow2为整数
Dim strList（）作为字符串
将名称设置为字符串
将索引设置为整数
“床单
设置sh1=图纸（“列表”）
设置sh2=工作表（“搜索”）
'设置Sheet1的起始行
tempRow1=1
'将所有行从星号循环到第1页A列的空白处
执行sh1.Range（“A”和tempRow1）”时
“知道名字吗
name=sh1.Range（“B”和tempRow1）
"按空间分割",
strList=Split（修剪（名称），“”）
'设置Sheet2的起始行
tempRow2=1
'重置标志
isFound=False
'将所有行从startRow循环到第2页A列的空白处
执行sh2.Range（“A”和tempRow2）”时
对于索引=LBound（strList）到UBound（strList）
'如果找到名称的一部分。
如果InStr（UCase（sh2.Range（“A”和tempRow2）），UCase（strList（index）））>0，则
'将true设置为搜索标志
isFound=True
'退出do循环
退出Do
如果结束
下一个索引
"增行"
tempRow2=tempRow2+1
环
'如果找到记录，则设置输出
如果我找到了
"算账",
sh1.Range（“D”和tempRow1）=sh2.Range（“B”和tempRow2）
'设置位置
sh1.Range（“E”和tempRow1）=sh2.Range（“C”和tempRow2）
如果结束
"增行"
tempRow1=tempRow1+1
环
端接头

如果公式解决方案是可接受的，则假设数据从第2行的两页开始

在活页1的单元格D2中插入以下公式并向下复制。

=查找（2^15，搜索（Sheet2！$A$2:$A$3，Sheet1！B2,1），Sheet2！$B$2:$B$3）

在活页1的E2单元格中插入以下公式并向下复制。

---

=LOOKUP（2^15，SEARCH（Sheet2！$A$2:$A$3，Sheet1！B2,1），Sheet2！$C$2:$C$3）

账户是否总是在B列中每笔交易的末尾？如果账号总是8位数，您可以使用正确的公式，不必进行拆分。@Harassedad不幸的是，没有。有些交易在描述中嵌入了“P245061”字样，这将是需要搜索并与数据列表进行比较的值。@SJR否，它不总是8位数字。如上所述，“P245061”是我需要搜索的另一个值。那么根本就没有模式吗？有多少个字符？数字和文字？