vba筛选两个excel工作表中相同时间的数据复制到一个新的工作表中

下面是一个示例代码，演示如何使用VBA将两个工作表中相同时间的数据筛选后复制到一个新的工作表中：

Sub FilterAndCopy()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
    Dim i As Long, j As Long
    
    '获取需要操作的三个工作表对象
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")
    Set ws3 = ThisWorkbook.Worksheets("Sheet3")
    
    '获取两个原始工作表的最后一行
    lastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    
    '清空目标工作表
    ws3.Cells.ClearContents
    
    '复制第一个工作表中满足条件的数据到目标工作表
    j = 1 '目标工作表的行数
    For i = 2 To lastRow1 '从第二行开始，第一行是表头
        If ws1.Cells(i, 1) <> "" Then '确保时间列不为空
            If Application.WorksheetFunction.CountIf(ws2.Columns(1), ws1.Cells(i, 1).Value) > 0 Then '如果第二个工作表中存在相同时间的数据
                ws1.Rows(i).Copy ws3.Rows(j) '将第一个工作表中的数据复制到目标工作表
                j = j + 1
            End If
        End If
    Next i
    
    '复制第二个工作表中满足条件的数据到目标工作表
    For i = 2 To lastRow2 '从第二行开始，第一行是表头
        If ws2.Cells(i, 1) <> "" Then '确保时间列不为空
            If Application.WorksheetFunction.CountIf(ws1.Columns(1), ws2.Cells(i, 1).Value) > 0 Then '如果第一个工作表中存在相同时间的数据
                ws2.Rows(i).Copy ws3.Rows(j) '将第二个工作表中的数据复制到目标工作表
                j = j + 1
            End If
        End If
    Next i
    
    '自适应调整目标工作表的列宽
    lastRow3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
    ws3.Cells.EntireColumn.AutoFit
End Sub

在上面的示例代码中，我们首先获取了需要操作的三个工作表对象，然后通过Cells函数和End(xlUp)方法获取了两个原始工作表的最后一行。接着，我们清空了目标工作表，然后依次遍历两个原始工作表中的每一行，筛选出时间列不为空且在另一个工作表中存在相同时间的数据，并使用Copy方法将其复制到目标工作表中。最后，我们使用EntireColumn.AutoFit方法自适应调整目标工作表的列宽。