VBA从字符串中提取变量引用然后查找

Question

从字符串中提取引用并在执行查找后遇到麻烦。

所以我在另一张纸上有一个查询表；

颜色A | B列

13453 |地方1

13099 |地方2

125515 |地方3

12357 |地方4

121671 |第五名

我有一个这样的导入清单中的付款参考清单，其中注明了长度上的差异；

CA13453 / 130

CA13099 / 33

CA125515 / 75

CA12357 / 1

CA121671 / 54

我想要帮助的是VBA，以找到付款参考的前5或6个数字，对照查询表进行检查，然后将地点名称粘贴到下一列中。运行代码后，导入选项卡将如下所示；

颜色A |进口单上的B列

CA13453 / 130 |地方1

CA13099 / 33 |地方2

CA125515 / 75 |地方3

CA12357 / 1 |地方4

CA121671 / 54 |第五名

让我知道您是否需要更多信息，非常感谢您的帮助！

Answer 1

这是您的两个选择。第一个是宏，它将处理导入表中的每一行。第二，使用一个函数，您必须将函数放在每一行中才能检索位置数据。

首先，宏用于处理“导入”表中的每一行。可以通过按alt + f8或在执行宏的工作簿中添加命令按钮来调用。

Sub GetLocationNames()

LocationShtNm = "Locations"  ' <---- Name of the sheet that has the location data
ImportShtNm = "Import"  ' <---- Name of the sheet that has the payment data
LocationStartRow = 2 ' <----- Change to the row that has the first row of location data in the Locations sheet
ImportStartRow = 2 ' <----- Change to the row that has the first row of payment data in the Imported data sheet
LocationKeyCol = 1 ' <----- Change to column that has the location names in the locations sheet
LocationNamesCol = 2 ' <----- Change to column that has the location names in the locations sheet
ImportKeyCol = 1 ' <----- Change to the column that has the payment number in the import sheet
ImportLocCol = 2 ' <----- Change to the column that has the location in the import sheet

Set LocationSheet = ActiveWorkbook.Sheets(LocationShtNm)
Set ImportSheet = ActiveWorkbook.Sheets(ImportShtNm)

'* Get the range for the traveller data
LocationLastRow = LocationSheet.UsedRange.Rows.Count
ImportLastRow = ImportSheet.UsedRange.Rows.Count

' Loop through the import data one row at a time
For i = ImportStartRow To ImportLastRow
    LocationKey = Mid(ImportSheet.Cells(i, ImportKeyCol), 3)
    SlashLoc = InStr(LocationKey, "/")
    LocationKey = Left(LocationKey, SlashLoc - 1)

    ' Loop through the location data and find the location
    FoundLoc = False
    For j = LocationStartRow To LocationLastRow
        If Trim(LocationSheet.Cells(j, LocationKeyCol)) = LocationKey Then
            FoundLoc = True
            CurrLocation = LocationSheet.Cells(j, LocationNamesCol).Value
            Exit For
        End If
    Next j

    If FoundLoc = True Then
        ImportSheet.Cells(i, ImportLocCol) = CurrLocation
    Else
        ImportSheet.Cells(i, ImportLocCol) = "Not Found"
    End If

Next i

End Sub

第二个是函数。您必须将其放入“导入”表每一行的单元格中，如下所示：

=GetLocationName(A2) ' Where A2 would have a payment reference number

这里是实现该功能的宏。

Function GetLocationName(CellIn)

LocationShtNm = "Locations"  ' <---- Name of the sheet that has the location data
ImportShtNm = "Import"  ' <---- Name of the sheet that has the payment data
LocationStartRow = 2 ' <----- Change to the row that has the first row of location data in the Locations sheet
ImportStartRow = 2 ' <----- Change to the row that has the first row of payment data in the Imported data sheet
LocationKeyCol = 1 ' <----- Change to column that has the location names in the locations sheet
LocationNamesCol = 2 ' <----- Change to column that has the location names in the locations sheet
ImportKeyCol = 1 ' <----- Change to the column that has the payment number in the import sheet
ImportLocCol = 2 ' <----- Change to the column that has the location in the import sheet

Set LocationSheet = ActiveWorkbook.Sheets(LocationShtNm)
Set ImportSheet = ActiveWorkbook.Sheets(ImportShtNm)

'* Get the range for the traveller data
LocationLastRow = LocationSheet.UsedRange.Rows.Count
ImportLastRow = ImportSheet.UsedRange.Rows.Count

LocationKey = Mid(CellIn.Value, 3)
SlashLoc = InStr(LocationKey, "/")
LocationKey = Left(LocationKey, SlashLoc - 1)

' Loop through the location data and find the location
FoundLoc = False
For j = LocationStartRow To LocationLastRow
    If Trim(LocationSheet.Cells(j, LocationKeyCol)) = LocationKey Then
        FoundLoc = True
        CurrLocation = LocationSheet.Cells(j, LocationNamesCol).Value
        Exit For
    End If
Next j

If FoundLoc = True Then
    GetLocationName = CurrLocation
Else
    GetLocationName = "Not Found"
End If


End Function

位置工作表：

导入工作表：