[已解决]按指定条件查询的问题

dfshm

附件 按条件查询.rar (124.79 KB, 下载次数: 9)

2014-2-17 17:07 上传

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

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-17 17:46

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim wb As Workbook, mypath$, arr, i&, j&
   
3. Application.ScreenUpdating = False
   
4. arr = Sheet1.[a1:e8]
   
5. mypath = ThisWorkbook.Path & ""
   
6. x = Sheet1.[h1]
   
7. For i = 1 To UBound(arr)
   
8.     If Application.CountA(Cells(i, 1).Resize(1, UBound(arr, 2))) = 0 Then GoTo line1
   
9.     Set wb = GetObject(mypath & Format(i, "00") & ".xls") '.xls可根据版本改为后缀名
   
10.     For j = 1 To UBound(arr, 2)
    
11.         If arr(i, j) <> "" Then arr(i, j) = wb.Sheets(1).Cells(arr(i, j), x)
    
12.     Next
    
13.     wb.Close 0
    
14. line1:
    
15. Next
    
16. Sheet2.Activate
    
17. Cells.ClearContents
    
18. Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
19. Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

dsmch

………………

dfshm

dsmch 发表于 2014-2-17 17:44

老师您好，这个程序用了一段时间后，发现了一点两个小问题：

一：当F列与F列后面的列，有数据时，查询不到；

二：当数据到了 H列后，用来输入 列标识的H1会被覆盖；

如下图：