关于按条件筛选值问题

sampsonpon · 发表于 2024-9-20 16:36

具体如图：

ykcbf1100 · 发表于 2024-9-20 16:56

附件供参考。。。

ykcbf1100 · 发表于 2024-9-20 16:56

参与一下。。。

Sub ykcbf() '//2024.9.20
Application.ScreenUpdating = False
With Sheets("Bridge_data")
r = .Cells(Rows.Count, 1).End(3).Row
arr = .Range("a1:q" & r)
rq = CDate(.[s1].Value)
End With
ReDim brr(1 To r, 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
If CDate(arr(i, 17)) > rq Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next
End If
Next
With Sheets("Picking List Data")
.UsedRange.Offset(1).ClearContents
.[a2].Resize(m, UBound(arr, 2)) = brr
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

ykcbf1100 · 发表于 2024-9-20 16:58

你直接操作单元格，速度肯定慢，你数据都快4万行了。
改用数组。

limonet · 发表于 2024-9-20 17:06

Sub limonet()
Sheets("Bridge_data").Columns("A:Q").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("R1:R2"), CopyToRange:=Range("A1"), Unique:=False
End Sub

limonet · 发表于 2024-9-20 17:18

Sub limonet()
Dim Cn As Object, StrSQL$
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
StrSQL = "Select * From [Bridge_data$A:Q] Where [CREATE TO DATE]>#" & Worksheets("Bridge_data").Range("S1") & "#"
Range("A2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

limonet · 发表于 2024-9-20 17:20

关键字：where

Qs18 · 发表于 2024-9-20 19:04

Sub qs()
Dim arr, i, rq
With Sheet2
rw = .Cells(Rows.Count, "q").End(xlUp).Row
arr = .Range("a2:q" & rw).Value
ReDim brr(1 To rw, 1 To UBound(arr, 2))
rq = CDate(.[s1].Value)
For i = 1 To UBound(arr)
If CDate(arr(i, 17)) > rq Then
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(i, j)
Next j
End If
Next i
End With
Sheet1.Range("a2").Resize(m, UBound(arr, 2)) = brr
End Sub

复制代码

Qs18 · 发表于 2024-9-20 19:05

试试..........

Qs18 · 发表于 2024-9-20 19:07

试试........

		自动登录	找回密码
密码			免费注册

[求助] 关于按条件筛选值问题

评分

评分

评分

评分