[已解决]如何用代码查询数据位置？

阿瑛

附件 查询数据位置.rar (119.54 KB, 下载次数: 14)

2014-2-13 23:20 上传

点击文件名下载附件
谢谢老师指点！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-14 06:25

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim wb As Workbook, rng As Range
   
3. Application.ScreenUpdating = False
   
4. For i = 1 To 8
   
5.     Set wb = GetObject(ThisWorkbook.Path & "" & Format(i, "00") & ".xls") '03版后缀名
   
6.     Set rng = wb.Sheets(1).Columns("" & [d1]).Find([e1], lookat:=xlWhole)
   
7.     If Not rng Is Nothing Then Cells(i, 1) = rng.Row
   
8.     wb.Close 0
   
9.     Set rng = Nothing
   
10. Next
    
11. Application.ScreenUpdating = True
    
12. End Sub
    

复制代码

dsmch

………………

阿瑛

dsmch 发表于 2014-2-14 06:25
………………

老师您好，谢谢您帮助。试了一下很好。只是有个地方，不知能否修改一下。

即表格的多少。附件中，只有8个表格，您的代码里固定为8，这个地方虽然可以根据表格多少进行修改，但有时候也很麻烦，不知能否修改为不限表格？

dsmch

1. Sub Macro1()
   
2. Dim wb As Workbook, rng As Range, fs$, i&, s&
   
3. Application.ScreenUpdating = False
   
4. fs = Dir(ThisWorkbook.Path & "\*.xls*")
   
5. Do While fs <> ""
   
6.     s = s + 1
   
7.     fs = Dir
   
8. Loop
   
9. For i = 1 To s - 1
   
10.     Set wb = GetObject(ThisWorkbook.Path & "" & Format(i, "00") & ".xls") '03版后缀名
    
11.     Set rng = wb.Sheets(1).Columns("" & [d1]).Find([e1], lookat:=xlWhole)
    
12.     If Not rng Is Nothing Then Cells(i, 1) = rng.Row
    
13.     wb.Close 0
    
14.     Set rng = Nothing
    
15. Next
    
16. Application.ScreenUpdating = True
    
17. End Sub
    

复制代码

hetianjun888

学习了