VBA统计最大值并且显示日期

洋务德雷

我这个简单，不用循环也可以解决。看看吧

cjc209

Sub 最新报价()
    Dim i, j, k, arr, brr, x, y
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    arr = Sheet1.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        If arr(i, 1) > 0 Then
            关键字 = arr(i, 5)
            If Not dic.exists(关键字) Then
                dic(关键字) = Array(arr(i, 4), 关键字, arr(i, 6), arr(i, 7), arr(i, 2), arr(i, 9))
            Else
                t = dic(关键字)
                If arr(i, 2) > t(4) Then
                    dic(关键字) = Array(arr(i, 4), 关键字, arr(i, 6), arr(i, 7), arr(i, 2), arr(i, 9))
                End If
            End If
        End If
    Next
    Sheet2.Range("a2").Resize(dic.Count, 6) = Application.Rept(dic.items, 1)
End Sub

nouce

洋务德雷 发表于 2023-3-26 16:15
我这个简单，不用循环也可以解决。看看吧

厉害，这个可以哦

nouce

cjc209 发表于 2023-3-26 16:49
Sub 最新报价()
    Dim i, j, k, arr, brr, x, y
    Dim dic

这个也可以，明天测试一下运算速度

lizhipei78

cjc209 发表于 2023-3-26 16:49
Sub 最新报价()
    Dim i, j, k, arr, brr, x, y
    Dim dic

原来字典还可以一次性写入这么多东西，又学习到了一招

不过有一个问题，在我这里，如果在统计表执行代码，会在最后一步写入时出错，说resize对象错误，你能帮我看一下吗？

我这个代码在大数据面前，应该比前面的要快，因为我的不要判断，只是装入字典，请楼主拿大数据进行测试

统计最新报价.rar (22.18 KB, 下载次数: 5)

2023-3-27 11:38 上传

点击文件名下载附件

lizhipei78

我这个简单，不用判断，请楼主拿大数据进行测试

nouce

lizhipei78 发表于 2023-3-27 11:39
我这个简单，不用判断，请楼主拿大数据进行测试

好的，今天晚点弄一下试试，感谢

nouce

cjc209 发表于 2023-3-26 16:49
Sub 最新报价()
    Dim i, j, k, arr, brr, x, y
    Dim dic

这个运算速度比其他人的要慢了不少，可以正常运行

nouce

lizhipei78 发表于 2023-3-27 11:39
我这个简单，不用判断，请楼主拿大数据进行测试

运行出错了
.Range([a1], [i65536].End(3)).Sort key1:=.Range("d1"), order1:=xlAscending, key2:=.Range("b1"), order2:=xlAscending, Header:=xlYes
这个地方“溢出”
然后原表的日期变成了2023/1/1，这样的格式了

准提部林

lizhipei78 发表于 2023-3-27 11:39
我这个简单，不用判断，请楼主拿大数据进行测试

1) 源資料...非必要..不去動它, 排序了就不是原樣
2) 字典的key最好定義型態, 可考慮都轉為文本, 速度可能會快些
3) 字典裝array...不見得較快, 只是可簡化代碼...簡化但不等于優化
4) 逐一讓字典裝array??? 若已排序, 可倒序...先判斷字典是否尚未容納.再裝入..減少動作