Question

我正在尝试创建此工具，该工具将通过查看支出列表来计算对每个员工的欠款。因此，从我们的帐户软件中，我可以导出包含2列的excel文档。第一列包含金额，第二列包含以下字符串：

“午餐，花了塔恩（Tanne）”

“火车票，安妮的支出”

“午餐，花丹尼斯”

“午餐，安妮的开支”

然后excel文档将查看所有费用并计算每个人的欠款总额。到目前为止，我已经使用以下代码来计算总量（一些变量是较早计算出来的，这只是计算总量的一部分）：

'Calcualte total amount
   For i = 1 To NamesTotal
       TotalAmount = 0
       NameString = UCase(Cells(i + 1, 7))
       For j = 1 To EntriesTotal
           CellText = UCase(Cells(j + 2, 3))
               If InStr(1, CellText, NameString) Then
                   Amount = Cells(j + 2, 4)
                   TotalAmount = TotalAmount + Amount         
               End If
           End If
       Next

       Cells(TableStart + i, 3) = Cells(i + 1, 7)
       Cells(TableStart + i, 4) = TotalAmount
       Cells(TableStart + i, 4).NumberFormat = "#,##0.00"
    Next

第7列列出了名称列表，第3列列出了字符串，第4列列出了数量。列表工作正常（我有更多代码），但问题出在名字彼此非常相似

If InStr(1, CellText, NameString) Then

在上面的示例中，名称“ Anne”是名称“ Tanne”的一部分，因此Tanne的列表也将包括Anne的费用。那么，如何更改代码以便找到完全匹配的代码？

Answer 1

您可以编写一个正则表达式函数，使用单词边界语法（即\ bName \ b

）将名称查找为单词

在我的示例中，该函数的参数等于CellText, NameString

here试试。

Option Explicit

Public Sub TEST()
    Dim rng As Range
    For Each rng In [A1:A4]
       If IsNamePresent(rng.Value, "Anne") Then
           'do something
       End If
    Next
End Sub

Public Function IsNamePresent(ByVal inputString As String, testName As String)
    IsNamePresent = False
    With CreateObject("vbscript.regexp")
        .Global = True
        .MultiLine = True
        .IgnoreCase = False '<== You may want to change this
        .Pattern = "\b" & testName & "\b"
        If .TEST(inputString) Then IsNamePresent = True
    End With
End Function

测试值：

正则表达式：

\ bAnne \ b / gm

\b在单词边界(^\w|\w$|\W\w|\w\W)中声明位置

Anne从字面上匹配字符Anne（区分大小写）

\b在单词边界(^\w|\w$|\W\w|\w\W)中声明位置。

因此，必须Anne作为单词，而不是Anne作为较长字符串的一部分。

Answer 2

一种可能的解决方案（获得所需结果的方式）：

Function getval(searchStr As String, rng As Range) As String
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim cl As Range, wrd
    For Each cl In rng
        For Each wrd In Split(Replace(cl.Value2, ",", ""))
            If LCase(wrd) = LCase(searchStr) Then dic.Add cl.Value2, ""
    Next wrd, cl
    getval = Join(dic.keys, vbNewLine)
End Function

测试

VBA-查找字符串中名称的完全匹配

2 个答案: