求助老师 VBA大于当天日期筛选出特定行数据保存到新的文件

d66191055

老师好   我想把样本中的  表1 和表2 中  通过条件  19列（发货日期）大于当天日期  的所对应行的内容筛选出来   目标 格式 如下

limonet

关键字：union all+where

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 xml;Data Source=" & ThisWorkbook.Path & "\" & Date & ".xlsx"
    StrSQL = "Select * From [Excel 12.0;DataBase=" & ThisWorkbook.FullName & "].[表1$] Union All Select * From [Excel 12.0;DataBase=" & ThisWorkbook.FullName & "].[表2$]"
    StrSQL = "Select * Into Sheet1 From (" & StrSQL & ") Where [发货日期]>=#" & Date & "#"
    Cn.Execute (StrSQL)
End Sub

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.9
   
2.     Application.ScreenUpdating = False
   
3.     rq = Date
   
4.     With Sheets("表2")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         arr = .[a1].Resize(r, 29)
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
9.     For i = 2 To UBound(arr)
   
10.         If arr(i, 19) > rq Then
    
11.             m = m + 1
    
12.             brr(m, 1) = m
    
13.             For j = 2 To UBound(arr, 2)
    
14.                 brr(m, j) = arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     With Sheets("表1")
    
19.         .UsedRange.Offset(1).Clear
    
20.         With .[a2].Resize(m, UBound(arr, 2))
    
21.             .Value = brr
    
22.             .Borders.LineStyle = 1
    
23.             .HorizontalAlignment = xlCenter
    
24.             .VerticalAlignment = xlCenter
    
25.         End With
    
26.     End With
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "OK！"
    
29. End Sub
    
30. 
    

复制代码

yanglinzi

1. Sub 筛选()
   
2. Dim arr, brr, i, j, r
   
3. ReDim brr(1 To 10000, 1 To 5)
   
4. For Each sh In Sheets
   
5.     If sh.Name <> "筛选" Then
   
6.         arr = sh.UsedRange
   
7.         td = Date
   
8.         For i = 2 To UBound(arr)
   
9.             sa = CDate(arr(i, 19))
   
10.             If sa > td Then
    
11.                 n = n + 1
    
12.                 brr(n, 1) = arr(i, 6)
    
13.                 brr(n, 2) = arr(i, 9)
    
14.                 brr(n, 3) = arr(i, 19)
    
15.                 brr(n, 4) = arr(i, 21)
    
16.                 brr(n, 5) = arr(i, 28)
    
17.             End If
    
18.         Next
    
19.     End If
    
20. Next
    
21. Sheet2.UsedRange.Offset(1).Clear
    
22. Sheet2.[c:c].NumberFormatLocal = "yyyy-m-d"
    
23. Sheet2.[a2].Resize(n, 5) = brr
    
24. End Sub
    

复制代码

yanglinzi

参与一下。。

d66191055

yanglinzi 发表于 2024-5-9 11:42
参与一下。。

老师  如果 指定打开的文件 例如F:\样本.xlsx 然后 按条件筛选 并将结果保存到F:/结果.xlsx 该怎么改  谢谢  

沈默00

你的表格里的日期格式居然不是标准的日期格式？？？？

d66191055

沈默00 发表于 2024-5-9 13:43
你的表格里的日期格式居然不是标准的日期格式？？？？

短日期格式