检查列中的值是否全部相同

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）

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

Answer 1

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

即

...
...

    '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，以使前一个银行的结果不会泄漏到您的下一个银行。