excel - 检查列中的值是否都相同

Question

目前我正在为一列创建检查。

目标：我有一个名为货币的列，我需要检查它们是否对于每个银行都相同（A 列）。如果有其他货币那么它会提示我。

附加目标：我还想在检查 E 列（货币（银行费用））中包含一个，以确保该银行的所有货币都是相同的。

问题：我已经有一个使用 scripting.dictionary 的工作代码，但是，我在清除第一个循环的字典/第一家银行的货币时遇到了一些麻烦。我试图在字典转到另一家银行之前清除它。但它不起作用。

以下是我要检查的屏幕截图：

以下是我拥有的当前代码：

Sub CurrencyTestCheck()

Dim wksSource As Worksheet: Set wksSource = ThisWorkbook.Sheets("Test1")

Dim i As Long
Dim x As Long
Dim lastRow As Long
Dim strBankName As String

Set d = CreateObject("Scripting.dictionary")

Application.ScreenUpdating = False

lastRow = wksSource.Cells(wksSource.Rows.Count, "C").End(xlUp).Row 

For i = 2 To lastRow

If Len(wksSource.Cells(i, 1).Value) > 0 Then 'If a new bank starts

        If Len(strBankName) > 0 Then

                For Each k In d.Keys

                    strCheck = k
                    countCurrency = d(k)

                    msg = msg & strCheck & " - " & countCurrency & vbNewLine
                    x = x + 1

                Next k

                If x > 1 Then

                    MsgBox "There are different currencies for bank " & strBankName & vbNewLine & _
                    vbNewLine & msg, vbCritical, "Warning"

                Else

                    MsgBox "Currencies are all the same for " & strBankName, vbInformation, "Same currencies"

                End If

                d.RemoveAll

        End If


strBankName = wksSource.Cells(i, 1).Value

End If

    'Currency for each Bank

    tmp = Trim(wksSource.Cells(i, 3).Value)
    If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1

Next i

If Len(strBankName) > 0 Then

    For Each k In d.Keys

        strCheck = k
        countCurrency = d(k)

        msg = msg & strCheck & " - " & countCurrency & vbNewLine
        x = x + 1

    Next k

    If x > 1 Then

        MsgBox "There are different currencies for bank " & strBankName & vbNewLine & _
        vbNewLine & msg, vbCritical, "Warning"

    Else

        MsgBox "Currencies are all the same for " & strBankName, vbInformation, "Same currencies"

    End If

End If

Application.ScreenUpdating = True

End Sub

输出：

以前的值仍在字典中（USD - 3 和 AUD - 2）

感谢您是否还有其他建议进行检查。

标签： excelvba

Answer 1

您可能忘记重置您的货币差异计数器x。
将其设置为x = 0在第一个银行的循环之后。

IE

...
...

    'Currency for each Bank

    tmp = Trim(wksSource.Cells(i, 3).Value)
    If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1

Next i

' Add these two lines:
x = 0
msg = ""

If Len(strBankName) > 0 Then

    For Each k In d.Keys

        strCheck = k

...
...

就像 TinMan 说的那样，也重置了msg上一个银行的结果，这样就不会泄露到你的下一个银行。