一、数组方案

Sub CustomFilter()
Dim Rng As Range, Arr As Variant
Dim EndRow As Long, EndCol As Long
Dim i As Long, j As Long
Dim n As Long
Dim StartDate, EndDate
Dim BeginTime, EndTime
Dim Brr() As String Dim StartTime As Variant
Dim UsedTime As Variant
StartTime = VBA.Timer '获取原始数据
With Sheets("原始数据")
'获取A列最后一行(非空行)的行号
EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
'获取第一行最后一列(非空列)的列号
EndCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
'保存数据
Set Rng = .Range(.Cells(2, 1), .Cells(EndRow, EndCol))
'Debug.Print Rng.Address
'存入数组
Arr = Rng.Value
End With '获取时间设定
With Sheets("筛选设定")
StartDate = .Range("A2").Text
EndDate = .Range("B2").Text
BeginTime = .Range("A4").Text
EndTime = .Range("B4").Text
End With '循环筛选符合条件的数据
'重新声明数组,用于保存筛选出来的数据
ReDim Brr(1 To EndCol, 1 To 1)
'初始化筛选结果的数量
n = 0
For i = LBound(Arr) To UBound(Arr)
If DateDiff("d", CDate(StartDate), CDate(Arr(i, 1))) >= 0 And _
DateDiff("d", CDate(Arr(i, 1)), CDate(EndDate)) >= 0 And _
Arr(i, 2) >= TimeValue(BeginTime) And _
Arr(i, 2) <= TimeValue(EndTime) Then
'时间在 Arr=Rng.Value的时候已经自动转为TimeValue
n = n + 1
ReDim Preserve Brr(1 To EndCol, 1 To n)
For j = 1 To EndCol
Brr(j, n) = Arr(i, j)
Next j
End If
Next i '输出结果
With Sheets("筛选数据")
'清除首行标题以外的内容
.UsedRange.Offset(1).ClearContents
'设置筛选数据的输出区域
Set Rng = .Range("A2")
Set Rng = Rng.Resize(UBound(Brr, 2), UBound(Brr))
'输出筛选结果
Rng.Value = Application.WorksheetFunction.Transpose(Brr)
End With Set Rng = Nothing UsedTime = VBA.Timer - StartTime
MsgBox "本次运行耗时:" & Format(UsedTime, "#0.0000秒") End Sub

 二、SQL方案

Sub ADO_SQL_QUERY_LOOP()
Dim StartTime As Variant
Dim UsedTime As Variant
StartTime = VBA.Timer '变量声明
Dim Wb As Workbook
Dim ResultSht As Worksheet
Dim DataSht As Worksheet
Dim Rng As Range
Dim DataPath As String
Dim SQL As String
Dim StartDate, EndDate
Dim BeginTime, EndTime
Dim CNN As Object
Dim RS As Object
Dim DATA_ENGINE As String '实例化对象
Set Wb = Application.ThisWorkbook
DataPath = Wb.FullName Set DataSht = Wb.Worksheets("原始数据")
Set ResultSht = Wb.Worksheets("筛选数据") '获取时间设定
With Wb.Worksheets("筛选设定")
StartDate = .Range("A2").Text
EndDate = .Range("B2").Text
BeginTime = .Range("A4").Text
EndTime = .Range("B4").Text
End With '根据版本设置连接字符串
Select Case Application.Version * 1
Case Is <= 11
DATA_ENGINE = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES;IMEX=2';Data Source="
Case Is >= 12
DATA_ENGINE = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=YES;IMEX=2'; Data Source= "
End Select '创建ADO Connection 连接器 实例
Set CNN = CreateObject("ADODB.Connection")
'创建 ADO RecordSet 记录集 实例
Set RS = CreateObject("ADODB.RecordSet")
'连接数据源
CNN.Open DATA_ENGINE & DataPath With ResultSht
'清除首行标题以外的内容
.UsedRange.Offset(1).ClearContents
EndRow = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
'设置输出结果区域
Set Rng = .Range("A2")
'设置查询语句
SQL = "SELECT * FROM [" & DataSht.Name & "$A1:Z] WHERE 日期 BETWEEN #" & StartDate & "# AND #" & EndDate & "# AND " & _
" 时间 BETWEEN #" & BeginTime & "# AND #" & EndTime & "#"
Debug.Print SQL
'执行查询 返回记录集
Set RS = CNN.Execute(SQL)
'复制记录集到指定Range
Rng.CopyFromRecordset RS
End With '关闭记录集
RS.Close
'关闭连接器
CNN.Close Set RS = Nothing
Set CNN = Nothing
Set Wb = Nothing
Set DataSht = Nothing
Set ResultSht = Nothing
Set Rng = Nothing UsedTime = VBA.Timer - StartTime
MsgBox "本次运行耗时:" & Format(UsedTime, "#0.0000秒") End Sub

  

 

20170813xlVBA跨表筛选数据的更多相关文章

  1. 如何Update跨表修改数据

    大家都知道用Update修改单个表的使用方法,现在来看一下用update 跨表修改数据: 首先创建表 a 然后创建表b 现在要把表b的company  根据ID更新到表a 方法一: update a ...

  2. 20170621xlVBA跨表转换数据

    Sub 跨表转置() Dim Wb As Workbook Dim Sht As Worksheet Dim oSht As Worksheet Dim Rng As Range Dim Index ...

  3. EXCEL 跨表比较数据

    Public Sub Compare(fullname As String, sheet As String) Dim conn, sql, rows, i, cellContents ,rowInd ...

  4. excel跨表查询数据

    环境:公司部分部门进行商品盘点,店铺经理要求不经过系统进行盘点,全程采用excel表格处理所示:            左图为总表,右图为首饰部门录入的数据 需求:找出盘点差异(即首饰部商品数量是否和 ...

  5. Drf 序列化 ModelSerializer跨表取数据

    1.对于OneToOne.Foreignkey.choices字段可以使用source取出相关信息: class CourseSerializer(serializers.ModelSerialize ...

  6. django框架基础-ORM跨表操作-长期维护

    ###############    一对一跨表查询    ################ import os if __name__ == '__main__': os.environ.setde ...

  7. django(3) 一对多跨表查询、ajax、多对多

    1.一对多跨表查询获取数据的三种形式:对象.字典.元组 例:有host与business两张表,host与business的id字段关联,business在host表中的对象名是b,  通过查询hos ...

  8. 教您如何进行SQL跨表更新

    SQL跨表更新数据是在使用SQL数据库中比较常用的,下面就将为您详细介绍SQL跨表更新数据的步骤,希望对您学习SQL跨表更新数据有所启迪. 原始数据如下,首先是表结构 A_dept的初始数据 A_em ...

  9. sql 游标例子 根据一表的数据去筛选另一表的数据

    sql 游标例子 根据一表的数据去筛选另一表的数据 DECLARE @MID nvarchar(20)DECLARE @UTime datetime DECLARE @TBL_Temp table( ...

随机推荐

  1. Java一元操作符++详解

    废话不多说,直接上代码. package com.coshaho.learn; /** * * OperatorLearn.java Create on 2016-11-13 下午8:38:15 * ...

  2. Google、亚马逊、微软 、阿里巴巴开源软件一览

    Google.亚马逊.微软 .阿里巴巴开源软件一览 大公司为什么要发布开源项目?一是开源能够帮助他人更快地开发软件,促进世界创新,主要是社会价值层面的考虑.二是开源能够倒逼工程师写出更好的代码.三是开 ...

  3. 利用canvas来绘制一个会动的图画

    <!DOCTYPE html> <html lang="en"> <head> <meta charset="UTF-8&quo ...

  4. Python学习笔记之面向对象编程(三)Python类的魔术方法

    python类中有一些方法前后都有两个下划线,这类函数统称为魔术方法.这些方法有特殊的用途,有的不需要我们自己定义,有的则通过一些简单的定义可以实现比较神奇的功能 我主要把它们分为三个部分,下文也是分 ...

  5. Kafka学习之(六)搭建kafka集群

    想要搭建kafka集群,必须具备zookeeper集群,关于zookeeper集群的搭建,在Kafka学习之(五)搭建kafka集群之Zookeeper集群搭建博客有说明.需要具备两台以上装有zook ...

  6. php在Nginx环境下进行刷新缓存立即输出,实现常驻进程轮询。

    以下面这段代码并不会逐个输出,而是当浏览器筹够一定字节数进行统一输出,结果显而易见,10秒后一次性输出所有内容 for($i=0;$i<10;$i++){ echo $i.'</br> ...

  7. [Linux 003]——用户和用户组以及 Linux 权限管理(一)

    嗬!没想到吧!学习 Linux 的第三天,我们已经开始接触用户管理,用户组管理,以及权限管理这几个逼格满满的关键字.这几个关键字对于前端程序猿的我来说真的是很高大上有木有,以前尝试学 Linux 的时 ...

  8. 20145304 Exp3 免杀原理与实践

    20145304 Exp3 免杀原理与实践 基础问题回答 (1)杀软是如何检测出恶意代码的? 检验特征码,包含特征码的代码会被杀软认为是恶意代码,例如一些常用恶意代码加壳后就有一个固定的代码会被认为是 ...

  9. flash,sram

    flash写入的内容不会因电源关闭而失去,读取速度慢,成本较低,一般用作程序存储器或者低速数据读取的情况. sram有最快的读写速度,但电源掉落后其内容也会失去,价格昂贵,一般用作cpu的二级缓存,内 ...

  10. Package libvirt was not found in the pkg-config search path

    关于pip安装libvirt-python的时候提示Package libvirt was not found in the pkg-config search path的问题解决方法 1.一开始以为 ...