[已解决]请高手帮忙解决问题

mfx123

附件中的代码是我从论坛中找的，自己修改不成功，要求速度快谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-12 16:10

考虑到“收款单”的条件，代码改动如下：

1. Sub 提取最近日期()
   
2.   Set d = CreateObject("scripting.dictionary")
   
3.   arr = Sheets("数据库").[a1].CurrentRegion
   
4.   For i = 2 To UBound(arr)
   
5.     If arr(i, 1) = "收款单" Then
   
6.         kh = arr(i, 6): rq = arr(i, 3)
   
7.         If rq > d(kh) Then d(kh) = rq
   
8.     End If
   
9.   Next
   
10.   With Worksheets("月余额表")
    
11.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.     arr = .Range("a5:J" & r)
    
13.     For i = 1 To UBound(arr)
    
14.         arr(i, 10) = d(arr(i, 2))
    
15.     Next
    
16.     .Range("j5").Resize(UBound(arr), 1) = Application.Index(arr, 0, 10)
    
17.   End With
    
18. End Sub

复制代码

跳转到最佳答案楼层

mfx123

请教高手

grf1973

1. Sub 提取最近日期()
   
2.   Set d = CreateObject("scripting.dictionary")
   
3.   arr = Sheets("数据库").[a1].CurrentRegion
   
4.   For i = 2 To UBound(arr)
   
5.     kh = arr(i, 6): rq = arr(i, 3)
   
6.     If rq > d(kh) Then d(kh) = rq
   
7.   Next
   
8.   With Worksheets("月余额表")
   
9.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.     arr = .Range("a5:J" & r)
    
11.     For i = 1 To UBound(arr)
    
12.         arr(i, 10) = d(arr(i, 2))
    
13.     Next
    
14.     .Range("j5").Resize(UBound(arr), 1) = Application.Index(arr, 0, 10)
    
15.   End With
    
16. End Sub

复制代码

grf1973

考虑到“收款单”的条件，代码改动如下：

1. Sub 提取最近日期()
   
2.   Set d = CreateObject("scripting.dictionary")
   
3.   arr = Sheets("数据库").[a1].CurrentRegion
   
4.   For i = 2 To UBound(arr)
   
5.     If arr(i, 1) = "收款单" Then
   
6.         kh = arr(i, 6): rq = arr(i, 3)
   
7.         If rq > d(kh) Then d(kh) = rq
   
8.     End If
   
9.   Next
   
10.   With Worksheets("月余额表")
    
11.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
12.     arr = .Range("a5:J" & r)
    
13.     For i = 1 To UBound(arr)
    
14.         arr(i, 10) = d(arr(i, 2))
    
15.     Next
    
16.     .Range("j5").Resize(UBound(arr), 1) = Application.Index(arr, 0, 10)
    
17.   End With
    
18. End Sub

复制代码

mfx123

请grf1973老师再修改，没有达到我要的效果，我想要根据客户编码和单据类型中收款单，提取最后一次收款的时间，请看附件中效果图，非常感谢老师

zjdh

根据条件查找最近日期.rar (126.85 KB, 下载次数: 26)

2016-4-12 16:14 上传

点击文件名下载附件

mfx123

甲单位最后一次收款时间：2015-8-13

mfx123

请grf1973老师再次修改

zjdh

看看6楼修改SQL的符合你的要求吗？

mfx123

感谢老师这么快就回复了，ZJDH老师能否用数组修改一下，sql数据大了，速度太慢，再次感谢两位老师