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 

随访自评

我需要引用大约30日期

喜欢的东西这（TES TED）

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