大神，指导一下怎么提取汇总工作薄数据至EXCEL

128022

大神，指导一下怎么提取汇总工作薄数据至EXCEL

3190496160

Sub 按钮1_单击()
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
lj = ThisWorkbook.Path & "\excel表收集\"          '把文件路径定义给变量
Dim br()
ReDim br(1 To 10000, 1 To 11)
f = Dir(lj & "*.xls*")            '依次找寻指定路径中的*.xls文件
Do While f <> ""                     '当指定路径中有文件时进行循环
   If f <> ThisWorkbook.Name Then
      Set wb = Workbooks.Open(lj & f)          '打开符合要求的文件
      With wb.Worksheets(1)
         r = .Cells(Rows.Count, 1).End(xlUp).Row
         ar = .Range("a2:h" & r - 2)
         xm = .Cells(r, 8)
     End With
     wb.Close False
     For i = 3 To UBound(ar)
         If Trim(ar(i, 2)) <> "" Then
             n = n + 1
             br(n, 1) = ar(1, 2)
             br(n, 2) = ar(1, 8)
             br(n, 3) = xm
             For j = 1 To 7
                 br(n, j + 3) = ar(i, j)
             Next j
         End If
     Next i
    End If
f = Dir
Loop
With ActiveSheet
    .UsedRange.Offset(2) = Empty
    .[a3].Resize(n, UBound(br, 2)) = br
    .[a3].Resize(n, UBound(br, 2) + 1).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成，请查看！", 64, "提示"
End Sub

3190496160

Sub 汇总()
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False        '冻结屏幕，以防屏幕抖动
lj = ThisWorkbook.Path & "\excel表收集\"          '把文件路径定义给变量
Dim br()
Set sh = ThisWorkbook.ActiveSheet
sh.UsedRange.Offset(2) = Empty
ReDim br(1 To 10000, 1 To 11)
f = Dir(lj & "*.xls*")            '依次找寻指定路径中的*.xls文件
Do While f <> ""                     '当指定路径中有文件时进行循环
   If f <> ThisWorkbook.Name Then
      Set wb = Workbooks.Open(lj & f)          '打开符合要求的文件
      With wb.Worksheets(1)
         r = .[b3].End(xlDown).Row
         rs = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
         ws = .Cells(Rows.Count, 8).End(xlUp).Row
         .Range("a3:h" & r).Copy sh.Cells(rs, 4)
         hs = r - 3
         sh.Cells(rs, 1).Resize(hs, 1) = .[b2]
         sh.Cells(rs, 2).Resize(hs, 1) = .[h2]
         sh.Cells(rs, 3).Resize(hs, 1) = .Cells(ws, 8)
     End With
     wb.Close False
    End If
f = Dir
Loop
Application.ScreenUpdating = True                 '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成，请查看！", 64, "提示"
End Sub

3190496160

第二段代码可能更适合你，前提是在wps中运行代码，因为你的数据源中有wps嵌入式图片
P采购订单.rar (331.96 KB, 下载次数: 2)

2023-3-22 11:02 上传

点击文件名下载附件

128022

128022

3190496160 发表于 2023-3-22 11:03
第二段代码可能更适合你，前提是在wps中运行代码，因为你的数据源中有wps嵌入式图片

大侠，“汇总后自己添加备注””那一列是在汇总后，自己添加的“是否到货”等备注，期间文件夹会不定期的往里添加EXCEL工作薄，再次进行汇总，能不能让““汇总后自己添加备注””那一列已有的数据，不要冲销啊？帮忙修改一下吧，谢谢哦！！！

3190496160

128022 发表于 2023-3-22 11:35
大侠，“汇总后自己添加备注””那一列是在汇总后，自己添加的“是否到货”等备注，期间文件夹会不定期 ...

希望每次汇总后，以前汇总过的就不汇总了，只汇总后面添加的工作簿
这点，针对你目前的说明是不可能做到的，因为，电脑毕竟不是人脑，不可能知道哪些文件是之前汇总过的，哪些是之前没有汇总过的，除非你有一个判断的依据

128022

3190496160 发表于 2023-3-22 12:19
希望每次汇总后，以前汇总过的就不汇总了，只汇总后面添加的工作簿
这点，针对你目前的说明是不可能做到 ...

可不可以用VBA表示，读取工作簿文件名，读取过的就不再汇总，工作簿的文件名是不会改的。

3190496160

128022 发表于 2023-3-25 11:08
可不可以用VBA表示，读取工作簿文件名，读取过的就不再汇总，工作簿的文件名是不会改的。

思路可行，但是得得调整目前代码的思路才行