[已解决]（求助）如何实现指定条件批量查询？

阿瑛

如附件 如何实现指定条件批量查询？.rar (194.26 KB, 下载次数: 26)

2011-9-22 16:58 上传

点击文件名下载附件

谢谢各位前辈老师！

前几天写了一个单表查询的，太费时费力。希望写个批量查询的，谢谢各位老师了。

最佳答案

月排行榜 / 总排行榜

liuguansky

2011-9-22 17:28

1. Sub justtest()
   
2.     Dim Arr(1 To 60000, 1 To 100), Si As Byte, Ei As Byte, Ar
   
3.     Dim Wb As Workbook, i&, p$, X$, A1 As Byte, A2&, j As Byte, G&
   
4.     Application.ScreenUpdating = False
   
5.     Si = [c1].Value: Ei = [d1].Value
   
6.     p = ThisWorkbook.Path & "\数据文件"
   
7.     X = Dir(p & "*.xlsx")
   
8.     If X <> "" Then
   
9.         Do
   
10.             A1 = A1 + 1
    
11.             Set Wb = GetObject(p & X)
    
12.             With Wb
    
13.                 With .Sheets(1)
    
14.                     Ar = .Range("A1").CurrentRegion.Value
    
15.                     For i = 3 To UBound(Ar, 1) - 3
    
16.                         If Ar(i, 1) = Si And Ar(i + 1, 1) = Ei Then
    
17.                             For j = 1 To 6
    
18.                                 A2 = A2 + 1
    
19.                                 Arr(A2, A1) = Ar(i - 3 + j, 1)
    
20.                             Next j
    
21.                             A2 = A2 + 1
    
22.                         End If
    
23.                     Next i
    
24.                 End With
    
25.                 .Close False
    
26.             End With
    
27.             X = Dir: G = G + A2: A2 = 0
    
28.         Loop Until X = ""
    
29.     End If
    
30.     Range("K1").Resize(Rows.Count, Columns.Count - 10).Clear
    
31.     With Range("k1").Resize(G, A1)
    
32.         .Value = Arr
    
33.         Application.ScreenUpdating = True
    
34.         MsgBox "处理成功，请看生成区域结果：" & .Address(0, 0)
    
35.     End With
    
36. End Sub
    

复制代码

如何实现指定条件批量查询？.rar (249.96 KB, 下载次数: 64)

2011-9-22 17:28 上传

点击文件名下载附件
请看是否这样效果！

跳转到最佳答案楼层

liuguansky

1. Sub justtest()
   
2.     Dim Arr(1 To 60000, 1 To 100), Si As Byte, Ei As Byte, Ar
   
3.     Dim Wb As Workbook, i&, p$, X$, A1 As Byte, A2&, j As Byte, G&
   
4.     Application.ScreenUpdating = False
   
5.     Si = [c1].Value: Ei = [d1].Value
   
6.     p = ThisWorkbook.Path & "\数据文件"
   
7.     X = Dir(p & "*.xlsx")
   
8.     If X <> "" Then
   
9.         Do
   
10.             A1 = A1 + 1
    
11.             Set Wb = GetObject(p & X)
    
12.             With Wb
    
13.                 With .Sheets(1)
    
14.                     Ar = .Range("A1").CurrentRegion.Value
    
15.                     For i = 3 To UBound(Ar, 1) - 3
    
16.                         If Ar(i, 1) = Si And Ar(i + 1, 1) = Ei Then
    
17.                             For j = 1 To 6
    
18.                                 A2 = A2 + 1
    
19.                                 Arr(A2, A1) = Ar(i - 3 + j, 1)
    
20.                             Next j
    
21.                             A2 = A2 + 1
    
22.                         End If
    
23.                     Next i
    
24.                 End With
    
25.                 .Close False
    
26.             End With
    
27.             X = Dir: G = G + A2: A2 = 0
    
28.         Loop Until X = ""
    
29.     End If
    
30.     Range("K1").Resize(Rows.Count, Columns.Count - 10).Clear
    
31.     With Range("k1").Resize(G, A1)
    
32.         .Value = Arr
    
33.         Application.ScreenUpdating = True
    
34.         MsgBox "处理成功，请看生成区域结果：" & .Address(0, 0)
    
35.     End With
    
36. End Sub
    

复制代码

如何实现指定条件批量查询？.rar (249.96 KB, 下载次数: 64)

2011-9-22 17:28 上传

点击文件名下载附件
请看是否这样效果！

阿瑛

回复 liuguansky 的帖子

谢谢老师。可惜附件下载不了啊。问了几个不同地方的同事，都一样，下载后不是该文件。

yangting

可惜不是2003版，不能使用~~~~~~