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

我可以建议三件事作为改进。

正确声明所有变量。例如，请考虑此行Dim myDate, myDate1, myDate2, myDate3 As Date。在vba中，只有最后一个变量将被声明为Date。休息将被声明为Variants
您可以使用Select Case代替IF
您无需使用.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

从评论中跟进

我需要参考大约30个日期

像这样（测试）

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

VBA：根据列表检查日期

1 个答案: