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)

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

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所以上一家银行的结果不会泄露到您的下一家银行。