根据文本日期范围提取期间的数据

zymwhy

各位老师，帮忙用VBA实现需求，非常感谢。

dragonthree

if arr(i,1)>=开始 then
   if arr(i,1)<=结束 then
     m=m+1
     省略
  end if
end if

gwjkkkkk

请参考....

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.1
   
2.     Dim arr, brr
   
3.     Application.ScreenUpdating = False
   
4.     With Sheets("数据源")
   
5.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .[a1].Resize(r, 3)
   
7.         rq1 = .[h1]
   
8.         rq2 = .[i1]
   
9.     End With
   
10.     ReDim brr(1 To UBound(arr), 1 To 3)
    
11.     m = 1
    
12.     brr(m, 1) = arr(1, 1)
    
13.     brr(m, 2) = arr(1, 2)
    
14.     brr(m, 3) = arr(1, 3)
    
15.     For i = 2 To UBound(arr)
    
16.         s = Val(arr(i, 1))
    
17.         If s >= rq1 And s <= rq2 Then
    
18.             m = m + 1
    
19.             For j = 1 To UBound(arr, 2)
    
20.                 brr(m, j) = arr(i, j)
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("提取数据")
    
25.         .Cells.Clear
    
26.         With .[a1].Resize(m, 3)
    
27.             .Value = brr
    
28.             .Borders.LineStyle = 1
    
29.             .HorizontalAlignment = xlCenter
    
30.             .VerticalAlignment = xlCenter
    
31.         End With
    
32.     End With
    
33.     Application.ScreenUpdating = True
    
34.     MsgBox "OK！"
    
35. End Sub
    
36. 
    

复制代码

ykcbf1100

附件供参考。。。

流浪星星

根据条件提取数据.zip (16.2 KB, 下载次数: 11)

2024-1-1 20:53 上传

点击文件名下载附件

zymwhy

gwjkkkkk 发表于 2024-1-1 20:33
请参考....

老师，我运行了一下，得不到结果啊。麻烦您再看一下吧。

gwjkkkkk

zymwhy 发表于 2024-1-1 20:58
老师，我运行了一下，得不到结果啊。麻烦您再看一下吧。

时间段中没有符合的所有没有，你可以改一下起始日期。

zymwhy

gwjkkkkk 发表于 2024-1-1 21:24
时间段中没有符合的所有没有，你可以改一下起始日期。

明白了，谢谢。

A刘志勇

你试试看看怎么样