如何提取同一文件夹下不同EXCEL工作簿中固定位置的数据

卡住了请等待

使用测试仪导出的数据在一个固定文件夹下，有几百个工作簿，现在需要提取每个工作簿中第一张表的B30、I30和J30三个单元格中的数据，能不能使用VBA编程实现在一个新的工作表中汇总提取出的数据，最终的效果能够像附件数据统计中那样最好


有没有大神能够指点一番，非常感谢

卡住了请等待

非常感谢，真的非常感谢，刚开始学习VBA，现在还是菜鸟，希望以后能达到你这种水平

18719881206

能否先查找文件名、表单名称，让符合文件名、表单名的再将固定的单元格代出
感谢！

andy5056

朱荣兴 发表于 2017-6-28 17:00
Sub 汇总()
Application.ScreenUpdating = False
Dim wb As Excel.Workbook

正在困惑这个问题，这次解决了，谢谢！

lele400024

朱荣兴 发表于 2017-6-28 17:00
Sub 汇总()
Application.ScreenUpdating = False
Dim wb As Excel.Workbook

想请教一下版主，如果目录下有子文件夹应该怎么写呢
子文件夹汇总.rar (113.2 KB, 下载次数: 99)

2018-2-9 14:37 上传

点击文件名下载附件

有一段合并工作簿的代码，研究了很久，不止如何修改，还请版主帮助，谢谢

1. Sub 合并表格()
   
2. Range("A1").CurrentRegion.Offset(1, 0).ClearContents
   
3. t = Timer
   
4. With Application.FileDialog(msoFileDialogFolderPicker)
   
5.     If .Show Then
   
6.         pathstr = .SelectedItems(1)
   
7.     Else
   
8.      Exit Sub
   
9.     End If
   
10. End With
    
11. On Error Resume Next
    
12. 
    
13. Application.ScreenUpdating = False
    
14. Dim arr(1 To 10000) As String
    
15. Dim f, cFile, i%, k%, x%
    
16. Dim wb As Workbook
    
17. arr(1) = pathstr & ""
    
18. 'arr(1) = ThisWorkbook.Path & ""
    
19. i = 1: k = 1
    
20. Do While i < UBound(arr)
    
21.     If arr(i) = "" Then Exit Do
    
22.     f = Dir(arr(i), vbDirectory)
    
23.     Do While f <> ""
    
24.         If InStr(f, ".") = 0 Then
    
25.             k = k + 1
    
26.             arr(k) = arr(i) & f & ""
    
27.         End If
    
28.         f = Dir
    
29.     Loop
    
30.     i = i + 1
    
31. Loop
    
32. 
    
33. For x = 2 To UBound(arr)
    
34.     If arr(x) = "" Then Exit For
    
35.     cFile = Dir(arr(x) & "*.xls?")
    
36.     Do While cFile <> ""
    
37.         Set wb = Workbooks.Open(arr(x) & cFile)
    
38.         For Each sht In wb.Worksheets
    
39.             If WorksheetFunction.CountA(sht.UsedRange) <> 0 Then
    
40.                 sht.Range("A1").CurrentRegion.Offset(1, 0).Copy Sheet1.Range("A65536").End(3).Offset(1, 0)
    
41.             End If
    
42.         Next
    
43.         wb.Close
    
44.         cFile = Dir
    
45.     Loop
    
46. Next x
    
47. Application.ScreenUpdating = True
    
48. End Sub

复制代码

464074263

请问如果不是B30、I30和J30三个单元格中的数据，而是文字对应的数字，怎么修改上述程序？
Sub 估值表取数()
Dim sht As Worksheet, i As Integer, j As Integer
'C列提取单位净值
For i = 1 To Worksheets.Count
        
        If Worksheets(i).Name <> "" Then
        For j = 1 To Worksheets(i).UsedRange.Rows.Count Step 1
        
         If Worksheets(i).Range("A" & j).Value Like "基金单位净值*" Then
        Worksheets("目录").Range("C" & i).Value = Worksheets(i).Range("H" & j).Value
        
        End If
         
        Next
        
        Else: Worksheets("目录").Range("C" & i).Value = 0
                  
        End If
Next