求助vba，根据条件列出最近的日期

qq78595624

求助大神们


请参考附件对应的日期数据在sheet“svc”
想在sheet“check”内显示出日期最接近(最大)的在b列

microyip

这个用SQL的 Select Max Group，一下就完了

qq78595624

大神
工作这里没有sql的环境...只能求vba。

不知何故

test.zip (11.38 KB, 下载次数: 30)

2018-8-22 13:22 上传

点击文件名下载附件

hefuqing

1. Sub ddf()
   
2. arr = Sheets("check").[a1].CurrentRegion
   
3. brr = Sheets("svc").[a1].CurrentRegion
   
4. 
   
5. For i = 2 To UBound(arr)
   
6.    For j = 1 To UBound(brr)
   
7.         If arr(i, 1) = brr(j, 1) And CDate(arr(i, 2)) < CDate(brr(j, 3)) Then
   
8.            arr(i, 2) = brr(j, 3)
   
9.         End If
   
10.     Next j
    
11. Next i
    
12. Sheets("check").[a1].CurrentRegion = arr
    
13. End Sub

复制代码

qq78595624

不知何故 发表于 2018-8-22 13:23

大神， 可过，数据一大，超慢的

qq78595624

hefuqing 发表于 2018-8-22 13:44

请问老师
将a列 和b列 改成 m列和n列后 报错了， 求助

Sub ddf()
arr = Sheets("check").[m1].CurrentRegion
brr = Sheets("svc").[a1].CurrentRegion

For i = 2 To UBound(arr)
   For j = 1 To UBound(brr)
        If arr(i, 13) = brr(j, 1) And CDate(arr(i, 14)) < CDate(brr(j, 3)) Then
           arr(i, 14) = brr(j, 3)
        End If
    Next j
Next i
Sheets("check").[m1].CurrentRegion = arr
End Sub

hefuqing

qq78595624 发表于 2018-8-22 15:32
请问老师
将a列 和b列 改成 m列和n列后 报错了， 求助

Sub ddf()
arr = Sheets("check").[a1].CurrentRegion
brr = Sheets("svc").[a1].CurrentRegion

For i = 2 To UBound(arr)
   For j = 1 To UBound(brr)
        If arr(i, 13) = brr(j, 1) And CDate(arr(i, 14)) < CDate(brr(j, 3)) Then
           arr(i, 14) = brr(j, 3)
        End If
    Next j
Next i
Sheets("check").[a1].CurrentRegion = arr
End Sub

kankan1030

1. Sub 去重()
   
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.     strSQL = "Select 序号,max(日期)as 最近日期  From [svc$] group by 序号"
    
15.     Conn.Open strConn
    
16.     Set Rst = Conn.Execute(strSQL)
    
17.     With Sheets("check")
    
18.         .Range("a:e").Clear
    
19.         For i = 0 To Rst.Fields.Count - 1
    
20.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
21.         Next i
    
22.         .Range("A2").CopyFromRecordset Rst
    
23.         .Cells.EntireColumn.AutoFit
    
24.     End With
    
25.     Rst.Close
    
26.     Conn.Close
    
27.     Set Conn = Nothing
    
28.     Set Rst = Nothing
    
29. End Sub
    

复制代码

加个标题用SQL最简单。

jiminyanyan

有多少数据量呀。。。