VBA:对照列表检查日期

Question

我正在尝试根据日期列表检查日期，如果找到，我需要将值从一列移至同一行的另一列。

下面是我开始做的事情，它有效，但我确信这是一种更清晰的查找列表的方法？

Sub Date_Check()

Dim lw As Long
Dim c As Range
Dim myDate, myDate1, myDate2, myDate3 As Date

myDate = Sheets("Cover").Range("G8")
myDate1 = Sheets("Cover").Range("G9")
myDate2 = Sheets("Cover").Range("G10")

lw = Range("A" & Rows.count).End(xlUp).Row

For Each c In Range("A1:A" & lw)
    If c = myDate Or c = myDate1 Or c = myDate2 Or c = myDate3 Then
        c.Offset(0, 6).Cut
        c.Offset(0, 9).Activate
        ActiveSheet.Paste
    End If
Next c

End Sub

我已经搜索看看我能找到什么，并看到数组被引用，但我不确定它是如何正常工作的？

任何指导将不胜感激。

谢谢。

Answer 1

我可以建议改进的三件事。

1. 正确声明所有变量。例如，考虑这一行Dim myDate, myDate1, myDate2, myDate3 As Date。在 vba 中，只有最后一个变量将被声明为 Date。其余部分将被声明为 Variants

2. 您可以使用Select Case代替IF

3. 您不需要使用.Select/Activate来剪切和粘贴。整个操作可以在一条线上完成。 INTERESTING READ

这就是您正在尝试的(已测试)

Sub Date_Check()
    Dim lw As Long
    Dim c As Range
    Dim myDate As Date, myDate1 As Date
    Dim myDate2 As Date, myDate3 As Date
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("WorkingSheet")

    myDate = ThisWorkbook.Sheets("Cover").Range("G8")
    myDate1 = ThisWorkbook.Sheets("Cover").Range("G9")
    myDate2 = ThisWorkbook.Sheets("Cover").Range("G10")

    With ws
        lw = .Range("A" & .Rows.Count).End(xlUp).Row

        For Each c In .Range("A1:A" & lw)
            Select Case c.Value
            Case myDate, myDate1, myDate2, myDate3
                c.Offset(0, 6).Cut c.Offset(0, 9)
            End Select
        Next c
    End With
End Sub

评论跟进

I need to reference around 30 dates

类似这样的东西(已测试)

Sub Date_Check()
    Dim lw As Long, i As Long
    Dim c As Range
    Dim myDate(1 To 30) As Date
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets("WorkingSheet")

    For i = 8 To 37
        myDate(i - 7) = ThisWorkbook.Sheets("Cover").Range("G" & i)
    Next i

    With ws
        lw = .Range("A" & .Rows.Count).End(xlUp).Row

        For Each c In .Range("A1:A" & lw)
            For i = 1 To 30
                Select Case c.Value
                Case myDate(i)
                    c.Offset(0, 6).Cut c.Offset(0, 9)
                    Exit For
                End Select
            Next i
        Next c
    End With
End Sub