Vba 应用程序。匹配不精确的值

有一段代码，用于查找两张表单之间的匹配项sheet1是客户列表，rData是与发票一起复制的pdf。它通常是完全匹配的，但在某些情况下，我会查找与rData匹配的6个字符

唯一让我头疼的是这部分结果=Application.Matchr，rData，0。不完全匹配如何得到匹配

活页样本1

这差不多就是这个样子。在CustomerNumber之后进行匹配很容易，因为它们在每张发票上都是相同的。但有时发票上并没有，所以我在搜索CustomerName，有时发票上有大写字母，有时发票后面有多余的东西，所以找不到精确的匹配。

---

希望它有意义

要将客户列表中的客户名称与发票中的客户名称进行匹配（即使附加了额外字符），可以在匹配中使用通配符*

“匹配”函数中也有输入错误。r20应该是rData

这是应用了修复程序的代码：

Sub Test()
  'v4
  Dim rData   As Variant
  Dim r       As Variant
  Dim r20  As Variant
  Dim result  As Variant
  Dim i       As Long

  rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")

  r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")

  For Each r In r20
    result = Application.Match(r & "*", rData, 0) ' <~ Fixed here
    If Not IsError(result) Then
      For i = 1 To 5
        If (result - i) > 0 Then
          If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
            MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
          End If
        End If
      Next
      For i = 1 To 15
        If (result + i) > 0 Then
          If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
            MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
          End If
        End If
      Next
    End If
  Next r

End Sub

注:

使用常量是一个好主意，这样所有的文本值只键入一次，并保持分组。 使用命名约定可以极大地提高代码的可读性，并降低出现错误的可能性。 使用长的、适当命名的变量使代码基本上是自文档化的。 强烈建议在读取单元格值时使用.Value2，这样可以避免隐式转换，使转换稍微快一点，并消除由转换引起的某些问题。 令人惊讶的是，在VBA中，有充分的理由将变量声明放在尽可能接近第一次使用变量的位置。其中两个原因是1它提高了可读性，2它简化了未来的重构。请记住，变量不会在每次遇到Dim时重新初始化。初始化只在第一次发生。 根据干燥原理，这两个线圈被卷成一个。 虽然检查空客户名称/编号不是严格必要的，如果您可以保证它永远不会是空的，但这是很好的防御性编程，因为空值将导致错误的结果。 循环中的负索引检查已被删除，并替换为在For语句中一次性使用Max sheet函数。 For语句中还使用了Min SHEEPAGE函数，以避免试图读取超过数组末尾的内容。 除非明确检查错误，否则请始终在工作表函数对象上使用工作表函数，在这种情况下，请使用应用程序对象。

---

根据r20中每个r的定义，r将在r20中，并且将完全匹配。。。你为什么想要不精确的匹配？r20中有哪些数据？请给我一些样品data@CallumDA如果要测试混合情况文本，请考虑将所有测试字符串更改为大写字母；也可以使用REGEX或InStr函数代替Match。谷歌的“Excel VBA字符串函数”具有很大的潜力solutions@ArturAlbertHamelak如果你已经看过我的答案，里面有一些错误。我现在修复了它们，并添加了额外的代码和注释。效果很好，但如何向阵列中添加额外的客户？有50多个。另外编辑我必须将Dim lngCustomerIndex更改为Dim lngCustomerIndex作为变量，以使其正常工作。@ArturAlbertHamelak-ლ Match实际上返回一个双精度。我只在短范围内进行了测试：应该将Dim dblCustomerIndex设置为Double。当然，变量总是有效的；-我还以为你会问关于改变顾客数量的问题呢。您可以将C2:C33更改为适当的范围。不过，我将上传一个新版本的代码，该代码会根据客户数量和发票数据的长度自动进行调整。@ArturAlbertHamelak没问题。我刚刚重新测试了代码，只要0418后面正好有五个数字，没有其他非空格字符，代码就可以正常工作。事先删除Rechnungs-Nr.0部分应该可以，但这会使代码复杂化，而且不必要，因为当前代码也应该可以。在您的评论中，您的意思是所有带前缀的发票号码都被忽略了，还是只忽略了其中的一部分？我能想到的唯一一件事是，这些发票号码在客户名称之前超过5个单元格，或者在客户名称之后超过15个单元格。您可以更改……代码中的值。如果这样做不起作用，您是否会在某个地方上传一个样本电子表格，其中至少包含一个被忽略的发票号和周围的单元格。在评论中发布电子表格的链接。正如你所建议的，我调整了n_InvScanStartOffset和n_InvScanEndOffset，这似乎解决了问题。

Sub Test()
  'v4
  Dim rData   As Variant
  Dim r       As Variant
  Dim r20  As Variant
  Dim result  As Variant
  Dim i       As Long

  rData = ActiveWorkbook.Sheets(2).Range("A1:A60000")

  r20 = ActiveWorkbook.Sheets(1).Range("C2:C33")

  For Each r In r20
    result = Application.Match(r & "*", rData, 0) ' <~ Fixed here
    If Not IsError(result) Then
      For i = 1 To 5
        If (result - i) > 0 Then
          If (Left(Trim(rData(result - i, 1)), 3) = "418") Then
            MsgBox "customer: " & r & ". invoice: " & rData(result - i, 1)
          End If
        End If
      Next
      For i = 1 To 15
        If (result + i) > 0 Then
          If (Left(Trim(rData(result + i, 1)), 3) = "418") Then
            MsgBox "customer: " & r & ". invoice: " & rData(result + i, 1)
          End If
        End If
      Next
    End If
  Next r

End Sub

Sub MuchBetter()
  'v3
  Const s_InvoiceDataWorksheet As String = "Sheet2"
  Const s_InvoiceDataColumn    As String = "A:A"
  Const s_CustomerWorksheet    As String = "Sheet1"
  Const s_CustomerStartCell    As String = "C2"
  Const s_InvoiceNumPrefix     As String = "418"
  Const n_InvoiceNumLength       As Long = 8
  Const n_InvScanStartOffset     As Long = -5
  Const n_InvScanEndOffset       As Long = 15

  Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction ' Shortcut

  With Worksheets(s_InvoiceDataWorksheet).Range(s_InvoiceDataColumn)
    With .Parent.Range(.Cells(1), .Cells(Cells.Rows.Count).End(xlUp))
      Dim varInvoiceDataArray As Variant
      varInvoiceDataArray = ƒ.Transpose(.Cells.Value2)
    End With
  End With
  With Worksheets(s_CustomerWorksheet).Range(s_CustomerStartCell)
    With .Parent.Range(.Cells(1), .EntireColumn.Cells(Cells.Rows.Count).End(xlUp))
      Dim varCustomerArray  As Variant
      varCustomerArray = ƒ.Transpose(.Cells.Value2)
    End With
  End With

  Dim varCustomer As Variant
  For Each varCustomer In varCustomerArray
    Dim dblCustomerIndex As Double
    dblCustomerIndex = Application.Match(varCustomer & "*", varInvoiceDataArray, 0)
    If Not IsError(dblCustomerIndex) _
    And varCustomer <> vbNullString _
    Then
      Dim i As Long
      For i = ƒ.Max(dblCustomerIndex + n_InvScanStartOffset, 1) _
          To ƒ.Min(dblCustomerIndex + n_InvScanEndOffset, UBound(varInvoiceDataArray))
        Dim strInvoiceNum As String
        strInvoiceNum = Right$(Trim$(varInvoiceDataArray(i)), n_InvoiceNumLength)
        If (Left$(strInvoiceNum, Len(s_InvoiceNumPrefix)) = s_InvoiceNumPrefix) Then
          MsgBox "customer: " & varCustomer & ". invoice: " & strInvoiceNum
        End If
      Next
    End If
  Next varCustomer

End Sub