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

d66191055

Qs18 发表于 2024-5-9 15:01
你以什么为依据来汇总

表1和表2中  第19列的日期大于当天日期 的行  汇总到一起保存到新excel中

Qs18

Sub test()
Dim wb As Workbook, wb2 As Workbook, arr, sht As Worksheet, k
crr = Array("图号", "名称", "需求日期", "数量", "订单日期")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wb = ThisWorkbook
td = Date
ReDim brr(1 To 100000, 1 To 5)
For Each st In wb.Sheets
    st.Activate
    arr = st.Range([a1], Cells(Rows.Count, 29).End(xlUp))
   
   
    For i = 2 To UBound(arr)
        If arr(i, 19) >= td Then
             k = k + 1
                brr(k, 1) = arr(i, 6)
                brr(k, 2) = arr(i, 9)
                brr(k, 3) = arr(i, 19)
                brr(k, 4) = arr(i, 21)
                brr(k, 5) = arr(i, 29)
        End If
    Next

Next
   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\结果.xlsx")

     
   Set sht = wb2.Sheets(1)
    sht.Cells(1, 1).Resize(1, 5) = crr
    sht.Range("a2").Resize(k, UBound(brr, 2)) = brr
    Columns("A:E").AutoFit
    wb2.Close (True)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheets("表1").Activate
MsgBox "汇总完毕！"
End Sub

limonet

d66191055 发表于 2024-5-9 13:56
老师   
这行 报错   Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 xml ...

也许是03或WPS，用其他大佬的数组方法

ykcbf1100

d66191055 发表于 2024-5-9 14:07
老师   你好  
可能是我表述的不清楚  
我的想法 是这样的  

你用其他老师的代码吧，我就不改了。

d66191055

Qs18 发表于 2024-5-9 15:17
Sub test()
Dim wb As Workbook, wb2 As Workbook, arr, sht As Worksheet, k
crr = Array("图号", "名 ...

老师  
结果是我的需求   
另  请老师 帮忙 将需要汇总的源文件 指向 F:/样本.xlsx
谢谢   

d66191055

ykcbf1100 发表于 2024-5-9 16:04
你用其他老师的代码吧，我就不改了。

非常感谢 老师    谢谢

Qs18

d66191055 发表于 2024-5-9 16:16
老师  
结果是我的需求   
另  请老师 帮忙 将需要汇总的源文件 指向 F:/样本.xlsx

您把文件的路径换成您的路径就可以了
您把路径换成Set wb2 = Workbooks.Open("F:\样本.xlsx")就可以了

"F:\样本.xlsx还要保证文件存在，不然的话要报错！

Qs18

您把路径换成Set wb2 = Workbooks.Open("F:\样本.xlsx")就可以了

Qs18

Qs18 发表于 2024-5-9 17:02
您把文件的路径换成您的路径就可以了

您要确定您的文件是否存在，不然要报错的！

d66191055

Qs18 发表于 2024-5-9 17:02
您把文件的路径换成您的路径就可以了
您把路径换成Set wb2 = Workbooks.Open("F:\样本.xlsx")就可以了
...

已 解决  谢谢 老师的帮助