部分string匹配,然后返回值

我正在努力快速编码银行交易。 我有一个银行数据下载表(表1),我想search说明(B列)与表2,列A的部分匹配。然后,如果匹配find,返回值从表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 

我正在尝试使用类似于“查找和获取”的解决scheme: Excel公式/ VBAsearch其他工作表中的部分string

但是,下面的代码将从工作表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 

如果公式解决scheme是可以接受的,那么假设数据在第2行的两张纸上开始。

在Sheet1的单元格D2中插入下面的公式并复制下来。 =LOOKUP(2^15,SEARCH(Sheet2!$A$2:$A$3,Sheet1!B2,1),Sheet2!$B$2:$B$3)

在Sheet1的单元格E2中插入以下公式并复制下来。 =LOOKUP(2^15,SEARCH(Sheet2!$A$2:$A$3,Sheet1!B2,1),Sheet2!$C$2:$C$3)