VBA：宏和按钮给出不同的结果

时间：2018-08-20 11:02:57

标签： date button format vlookup

我正在VBA上做一个项目。

在名为“数据库”的工作表中，列出了带有银行假日货币的日期列表。从现在到2041年，还有周末的清单。

我的任务是编写代码，使我可以检查“表2”中粘贴的日期范围是否包含“数据库”中的日期。

我必须在“数据库”表中检查“表2”的第2列和第4列。

用户还可以决定要检查的频率，因此在这种情况下，将有一个UserForm调用该宏以检查“数据库”表中的正确范围。

您可以在代码下面看到它，虽然很长，但重复：

用户表单

Private Sub CheckBox1_Click()
Call WeekEndsCheck
Call EURCheck
End Sub
Private Sub CheckBox2_Click()
Call WeekEndsCheck
Call JPYCheck
End Sub
Private Sub CheckBox3_Click()
Call WeekEndsCheck
Call USDCheck
End Sub
Private Sub CheckBox4_Click()
Call WeekEndsCheck
Call GBPCheck
End Sub
Private Sub CheckBox5_Click()
Call WeekEndsCheck
Call CHFCheck
End Sub
Private Sub CheckBox6_Click()
Call WeekEndsCheck
Call KRWCheck
End Sub
Private Sub CheckBox7_Click()
Call WeekEndsCheck
Call PLNCheck
End Sub
Private Sub CheckBox8_Click()
Call WeekEndsCheck
Call AUDCheck
End Sub
Private Sub CheckBox9_Click()
Call WeekEndsCheck
Call HUFCheck
End Sub
Private Sub CheckBox10_Click()
Call WeekEndsCheck
Call SEKCheck
End Sub
Private Sub CheckBox11_Click()
Call WeekEndsCheck
Call NOKCheck
End Sub
Private Sub CheckBox12_Click()
Call WeekEndsCheck
Call HKDCheck
End Sub
Private Sub CheckBox13_Click()
Call WeekEndsCheck
Call CZKCheck
End Sub

模块：

Sub WeekEndsCheck()
    Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("A:A"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("A:A"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub
Sub EURCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("B:B"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("B:B"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub
Sub JPYCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("C:C"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("C:C"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub USDCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("D:D"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("D:D"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub GBPCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("E:E"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("E:E"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub CHFCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("F:F"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("F:F"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub KRWCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("F:F"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("G:G"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub PLNCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("H:H"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("H:H"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub AUDCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("I:I"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("I:I"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub HUFCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("J:J"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("J:J"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub SEKCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("K:K"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("K:K"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub NOKCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("L:L"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("L:L"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub HKDCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("M:M"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("M:M"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

Sub CZKCheck()

Dim cell As Range
    Dim Ret As Variant

    For Each cell In Worksheets("Sheet2").Range(Range("B2"), Range("B2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("N:N"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

For Each cell In Worksheets("Sheet2").Range(Range("D2"), Range("D2").End(xlDown))
        On Error Resume Next
        Ret = Application.WorksheetFunction.VLookup(cell, _
              Worksheets("DataBase").Range("N:N"), 1, 0)
        On Error GoTo 0

        If Ret <> "" Then
            If cell = Ret Then
                cell.Interior.Color = RGB(255, 0, 0)
            End If
            Ret = ""
        End If
    Next

End Sub

如果我从“开发人员”选项卡启动“宏”，则代码可以正常工作，但是当我将邮件附加到按钮（附加了用户窗体）后，它将给我带来不同的结果。

通过消除On Error Resume Next，我的运行时错误为1004。

总而言之，代码在我执行Developer->Macros->MacroName->Run时起作用。

我可以轻松地检查它是否运行良好，但是当我从用户窗体启动它时，或者如果我只是通过按钮运行它，则返回错误结果。

我怎么可能有两个不同的结局？

日期格式有问题吗？当我调试宏时，我看到的是数字而不是日期。

0 个答案:

没有答案
相关问题
最新问题