[已解决]提取多个工作簿中的数值

linweidt

提取多个工作簿中的数值.zip (36.74 KB, 下载次数: 24)

2015-3-21 10:40 上传

点击文件名下载附件
如附件所示，要求提取中各个工作簿的名称，及各个工作簿中的sheet1中的“合计”对应的数值，请各位大虾帮帮忙，谢啦{:021:}

最佳答案

月排行榜 / 总排行榜

冥王

2015-3-21 11:22

1. Sub demo()
   
2.     Application.ScreenUpdating = False
   
3.     Dim iPath As String, iFile As String, i As Integer
   
4.     Dim wb As Workbook, arr(1 To 100, 1 To 2)
   
5. 
   
6.     iPath = ThisWorkbook.Path & ""
   
7.     iFile = Dir(iPath & "*.xlsx")
   
8. 
   
9.     Do While iFile <> ""
   
10.         If iFile <> ThisWorkbook.Name Then
    
11.             Set wb = Workbooks.Open(iPath & iFile)
    
12.             i = i + 1
    
13.             arr(i, 1) = Replace(wb.Name, ".xlsx", "")
    
14.             arr(i, 2) = wb.Sheets(1).Cells.Find(What:="合计").Offset(0, 1).Value
    
15.             wb.Close False
    
16.         End If
    
17.         iFile = Dir
    
18.     Loop
    
19.     ThisWorkbook.Sheets(1).Cells(2, 1).Resize(100, 2) = arr
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码

跳转到最佳答案楼层

冥王

1. Sub demo()
   
2.     Application.ScreenUpdating = False
   
3.     Dim iPath As String, iFile As String, i As Integer
   
4.     Dim wb As Workbook, arr(1 To 100, 1 To 2)
   
5. 
   
6.     iPath = ThisWorkbook.Path & ""
   
7.     iFile = Dir(iPath & "*.xlsx")
   
8. 
   
9.     Do While iFile <> ""
   
10.         If iFile <> ThisWorkbook.Name Then
    
11.             Set wb = Workbooks.Open(iPath & iFile)
    
12.             i = i + 1
    
13.             arr(i, 1) = Replace(wb.Name, ".xlsx", "")
    
14.             arr(i, 2) = wb.Sheets(1).Cells.Find(What:="合计").Offset(0, 1).Value
    
15.             wb.Close False
    
16.         End If
    
17.         iFile = Dir
    
18.     Loop
    
19.     ThisWorkbook.Sheets(1).Cells(2, 1).Resize(100, 2) = arr
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码

ULCY

路过，学习学习

冥王

ULCY 发表于 2015-3-21 13:09
路过，学习学习

设置启用宏 代码才能运行 自己试

ULCY

老师，请看看附件哪里错了？

ULCY

晕，我怎不能上传压缩文件？

ULCY

OK，成功了，代码里没去掉顺序号，呵呵，谢谢冥王老师

linweidt

冥王 发表于 2015-3-21 11:22

谢谢大虾啦{:221:}