大神帮帮忙，这个实用很强，菜鸟都在线等

work_01

各位大神、高手，若是能抽出您宝贵的时间阅读下小弟的问题予以帮助，小弟将不胜感激！

一指禅62

1. Sub 筛选()
   
2.     Dim arr, a(), n%, i&, j%, key$, t1 As Date, t2 As Date
   
3.     Rem 数据准备
   
4.     If Range("M1") = "" Then MsgBox "请输入井号！": Range("M1").Select: Exit Sub
   
5.     If Range("O1") = "" Or Not IsDate(Range("O1")) Then MsgBox "请输入正确的开始日期！": Range("O1").Select: Exit Sub
   
6.     If Range("Q1") = "" Or Not IsDate(Range("Q1")) Then MsgBox "请输入正确的结束日期！": Range("Q1").Select: Exit Sub
   
7.     key = Range("M1"): t1 = Range("O1"): t2 = Range("Q1")
   
8.     If t1 > t2 Then MsgBox "结束日期不得小于开始日期！": Exit Sub
   
9.     arr = Sheet1.Range("A1").CurrentRegion
   
10.     Rem 筛选
    
11.     For i = 2 To UBound(arr)
    
12.         If arr(i, 1) = key And arr(i, 2) >= t1 And arr(i, 2) <= t2 Then
    
13.             n = n + 1: ReDim Preserve a(1 To 7, 1 To n)
    
14.             For j = 1 To 7
    
15.                 a(j, n) = arr(i, j)
    
16.             Next
    
17.         End If
    
18.     Next
    
19.     Rem 输出筛选结果
    
20.     With Sheet1.Range("L4:R65536")
    
21.         .Borders.LineStyle = xlNone
    
22.         .ClearContents
    
23.     End With
    
24.     If n > 0 Then
    
25.         With Sheet1.Range("L4").Resize(n, 7)
    
26.             .Value = WorksheetFunction.Transpose(a)
    
27.             .Borders.LineStyle = xlContinuous
    
28.         End With
    
29.     Else
    
30.         MsgBox "没有匹配到数据！"
    
31.     End If
    
32. End Sub

复制代码

一指禅62

请教高手问题.zip (16.6 KB, 下载次数: 42)

2018-2-10 10:14 上传

点击文件名下载附件

work_01

非常感谢一指蝉62的帮助

蓝桥玄霜

把A1单元格改为“井号”，切记。
请见代码。

work_01

非常感谢 蓝桥玄霜 帮忙解决

jsgj2023

1. Sub Adele1()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, strSQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14.     Conn.Open strConn
    
15.             strSQL = "select [井 号],日期,生产时间  from [Sheet1$a1:g] where 日期  between #" & [o1] & "# and #" & [q1] & "# group by  [井 号],日期,生产时间 having [井 号]='" & [m1] & "'"
    
16.     Set Rst = Conn.Execute(strSQL)
    
17.     With Sheet1
    
18.         .Range("l4:r65535").ClearContents
    
19.         .Range("l4").CopyFromRecordset Rst
    
20.         .Cells.EntireColumn.AutoFit
    
21.     End With
    
22.     Rst.Close
    
23.     Conn.Close
    
24.     Set Conn = Nothing
    
25.     Set Rst = Nothing
    
26. End Sub

复制代码

jsgj2023

请见附件!!!

jsgj2023

sql语句修改一下!

1. strSQL = "select [井 号],日期,生产时间,[液量（m3）],[含水（%）],[净油（t）],备注 from [Sheet1$a1:g] " _
   
2.             & "where 日期 between #" & [o1] & "# and #" & [q1] & "# group by  [井 号],日期,生产时间,[液量（m3）],[含水（%）],[净油（t）],备注 having [井 号]='" & [m1] & "'"

复制代码

Chip_Kenny

湊熱鬧, 代碼全由mouse click執行,詳看附件: