从列表中提取与特定日期匹配的值-Excel VBA Loop

Question

请非常感谢excel VBA的帮助-

我在一张纸上有2个数据列，中间还有空白

  name         Date
   a        01-01-2019
   c        01-08-2019

   b        01-02-2019
   f        01-01-2019 

. . .

我试图在同一工作簿的另一张纸上显示按日期顺序组织的这些列，没有空格。例如：

 name      date
  a       01-01-19
  f       01-01-19
  b       01-02-19
  c       01-08-19

我尝试使用包含一些If语句的For Each循环，但是并没有达到预期的效果，我认为这将是一个漫长的过程-我是VBA的新手，努力使循环正常工作并获得正确的结果。我看过while循环，但不确定这是否是正确的方法？

非常感谢您的光临！

编辑：到目前为止，已在代码中添加-（我知道它不好）！

Dim r As Range
 Dim t As Range
 Dim r2 As Range
 Dim t2 As Range
 Dim rData As Range
 Set rData = Range("C4:C70") 

 Set r = Sheets("Sheet1").Range("D4") 
 Set r2 = Sheets("Sheet1").Range("C4")  
 Set t = Sheets("Sheet2").Range("D4") 
 Set t2 = Sheets("Sheet2").Range("C4")  


  For Each r2 In rData 
    If r.Value = "01/09/2018" Then
     t = r  
      t2 = r.Offset(0, -1)
    Set r = r.Offset(1, 0) 
      Set r2 = r2.Offset(1, 0) 
      Set t = t.Offset(1, 0) 
      Set t2 = t2.Offset(1, 0) 
    End If
   If r.Value <> "" & r2.Value <> "" Then
        Set r = r.Offset(1, 0) 
        Set r2 = r2.Offset(1, 0) 
       Set t = t.Offset(1, 0) 
        Set t2 = t2.Offset(1, 0) 

   End If
    If r.Value = "01/10/2018" Then
     t = r  
     t2 = r.Offset(0, -1)

    End If
  Next r2

Answer 1

在这里-比录制的宏干净一点。

Sub SortDates()

Dim sht As Worksheet, sht2 As Worksheet, lastrow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
lastrow = sht.Cells(sht.Rows.Count, 3).End(xlUp).Row

sht2.Range("C1:D" & lastrow).Value = sht.Range("C1:D" & lastrow).Value

sht2.Sort.SortFields.Add Key:=Range("D1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
sht2.Sort.SetRange Range("C1:D" & lastrow)
sht2.Sort.Apply

End Sub