当前位置: 代码迷 >> Office >> 用VB 快速查询数据,该怎么处理
  详细解决方案

用VB 快速查询数据,该怎么处理

热度:7686   发布时间:2013-02-26 00:00:00.0
用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
  相关解决方案