用于检查列表的 VBA 模块，包含来自动态列表的两个名称

Question

我正在尝试自动化会计流程。每个月我都会收到一份费用清单，我必须计算每个人的总金额。一个单元格将包含一些文本，说明它是什么以及哪个员工带来了这个项目，旁边的一个将指定金额。

我创建了一个脚本，它将查看列表并为我提供每位员工的总费用。可能的名称在文档的范围内指定。

问题在于，其中一些单元格有时会包含两个姓名，然后将金额添加到两个员工的总金额中。

问题： 如果单元格包含我列表中的 两个 名称，是否可以创建一个 If 语句来查看我的姓名列表并“做某事”。

编辑：这是我已经创建的循环

Sub AfstemLoop()
    Worksheets("Main").Activate

    Dim NamesAmount As Integer
    Dim NameString As String
    Dim TotalAmount As Double
    Dim TableStart As Integer

    'Count Amount of names
    NamesTotal = 0
    For i = 1 To 100
        If Worksheets("Main").Cells(i + 1, 7) <> "" Then
            NamesTotal = NamesTotal + 1
        End If
    Next

    'Count entries
    EntriesTotal = 0
    For i = 1 To 1000
        If Worksheets("Main").Cells(2 + i, 1) <> "" Then
            EntriesTotal = EntriesTotal + 1
        End If
    Next

    'Define table start
    TableStart = EntriesTotal + 4

    'Calculate total amount
    For i = 1 To NamesTotal
        TotalAmount = 0
        NameString = Worksheets("Main").Cells(i + 1, 7)
        For j = 1 To EntriesTotal
            CellText = Worksheets("Main").Cells(j + 2, 3)
            If InStr(1, CellText, NameString) Then
                Amount = Worksheets("Main").Cells(j + 2, 4)
                TotalAmount = TotalAmount + Amount
                    'Test to see if cell has been used (in case of spelling mistakes)
                    Worksheets("Main").Cells(j + 2, 4).Interior.Color = 5296274
            End If
        Next

        Worksheets("Main").Cells(TableStart + i, 3) = NameString
        Worksheets("Main").Cells(TableStart + i, 4) = TotalAmount
        Sum = TotalAmount + Sum
   Next

   Worksheets("Main").Cells(TableStart + NamesTotal + 1, 3) = "Total"
   Worksheets("Main").Cells(TableStart + NamesTotal + 1, 4) = Sum

End Sub

Answer 1

您检查名称是否出现并在每次出现时执行操作：

For j = 1 To EntriesTotal
    CellText = Worksheets("Main").Cells(j + 2, 3)
    If InStr(1, CellText, NameString) Then
        Amount = Worksheets("Main").Cells(j + 2, 4)
        TotalAmount = TotalAmount + Amount
            'Test to see if cell has been used (in case of spelling mistakes)
            Worksheets("Main").Cells(j + 2, 4).Interior.Color = 5296274
    End If
Next

您想要更改它，以便代码根据单元格中名称的数量执行不同的任务。我建议你引入一个名称出现计数器：

Dim namesInCellCount as long
namesInCellCount = 0

For j = 1 To EntriesTotal
    CellText = Worksheets("Main").Cells(j + 2, 3)
    If InStr(1, CellText, NameString) Then
        namesInCellCount = namesInCellCount + 1
    End If
Next

If namesInCellCount = 1 then
    'do your thing
ElseIf namesInCellCount > 1 then
    'do your other thing
End If

请记住在您使用完一个单元格之后（或在您开始检查一个新单元格之前）重置计数器。 Dim 语句位于代码的顶部，位于其他此类语句旁边。