用VB 快速查询数据
我要从一个源文件(也是Excel的)中按照多个条件选取数据.现在用的是Do..Loop 循环,里面用if语句一行一行去找,太慢了.能否快速查找.谢谢!
Private StDate, DueDate, Op, Line, Process, Cyc As String
Private MinDate, MaxDate As String
Private PreTest As Boolean
Private Endrow, Opinion1 As Integer
Sub 数据调入预处理() '预处理,将原始数据调入
StDate = Range("G8")
DueDate = Range("L8")
Op = Range("R7")
Line = Range("L7")
Process = Range("L9")
Cyc = Range("G7") '查询时间单位
Opinion1 = 0
初始判断
If Opinion1 = 1 Then
调取原始数据
End If
End Sub
Sub 初始判断()
If StDate = "" Or DueDate = "" Then
MsgBox ("请输入观察时间段!")
ElseIf Not IsDate(StDate) Then
MsgBox ("请按正确格式输入起始时间!(如:2009-05-01)")
ElseIf Not IsDate(DueDate) Then
MsgBox ("请按正确格式输入结束时间!(如:2009-05-01)")
ElseIf StDate > DueDate Then
MsgBox ("数据结束时间不能小于开始时间!")
ElseIf DueDate > Date Then
MsgBox ("数据结束时间不能大于今天!")
Else:
Application.ScreenUpdating = False
Sheets("Original Data").Select
Range("A1").Select '此处链接打开原始数据
Selection.Hyperlinks(1).Follow
Sheets("Data").Activate
Endrow = Application.CountA(Sheets("Data").Range("A1:A60000"))
MinDate = Sheets("Data").Cells(2, 1)
MaxDate = Sheets("Data").Cells(Endrow, 1)
If MinDate > DueDate Then '2.2.1判断查询时间区间是否超出记录范围
MsgBox ("查询结束时间小于数据库最小记录时间(" & MinDate & "),请重新选择观察时间段!")
ActiveWindow.Close
Application.ScreenUpdating = True
ElseIf StDate > MaxDate Then
MsgBox ("查询开始时间大于数据库最大记录时间(" & MaxDate & "),请重新选择观察时间段!")
ActiveWindow.Close
Application.ScreenUpdating = True
Else
If StDate < MinDate Then
StDate = MinDate
Windows("FIN Process Monitor.xls").Activate
Sheets("main").Range("G8") = MinDate
MsgBox "起始日期小于数据库最小记录时间(" & MinDate & "),将用最小日期代替！"
End If
If DueDate > MaxDate Then
DueDate = MaxDate
Windows("FIN Process Monitor.xls").Activate
Sheets("main").Range("L8") = MaxDate
MsgBox "结束日期大于数据库最大记录时间(" & MaxDate & "),将用最大记录时间代替！"
End If
Windows("FIN Process Monitor.xls").Activate '2.2.3 清除原有数据
Sheets("Original Data").Select
Range("A4:BZ1000").Select
Selection.ClearContents
With Selection.Font
.Size = 8
.ColorIndex = xlAutomatic
End With
Opinion1 = 1
End If
End If
End Sub
Sub 调取原始数据()
Dim X1, X2 As Integer
X1 = 3
X2 = 1
Sheets("Original Data").Select '转到源数据
Range("A1").Select
Selection.Hyperlinks(1).Follow
Sheets("Data").Select
Sheets.Add
Do While StDate <= DueDate
Do While X1 <= Endrow '一天内的数据
Sheets("Data").Select
If Cells(X1, 1) = StDate Then
Rows(X1).Select
Selection.Copy
Sheets("Sheet1").Select
Rows(X2).Select
Selection.PasteSpecial Paste:=xlPasteValues
X2 = X2 + 1
End If
X1 = X1 + 1
Loop
X1 = 3
StDate = StDate + 1
Loop
Sheets("Sheet1").Select
Rows(1 & ":" & X2).Select
Selection.Copy
Windows("FIN Process Monitor.xls").Activate
Sheets("Original Data").Select
Cells(4, 1).Select
ActiveSheet.Paste
Rows("3:3").Select '调整单元格格式
Application.CutCopyMode = False
Selection.Copy
Rows(1 & ":" & X2 + 2).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Sheets("Original Data").Select '转到源数据并关闭它
Range("A1").Select
Selection.Hyperlinks(1).Follow
ActiveWindow.Close
Application.ScreenUpdating = True
Application.CutCopyMode = False '屏蔽剪贴板对话框
End Sub
[解决办法]
直接用ＥＸＣＥＬ中的外部数据中的MS QUERY可以简单实现。
QQ群 48866293 OFFICE应用挖掘
MS OFFICE(ACCESS\EXCE\WORD等应用技术探讨与交流！技术群,请阅群论坛中的《踢人规则》
