运行后排名代码错误，请大神一助！谢谢

longyi999

在我的第二张表中，需要对查询结果根据BY列进行排名，请过路大神帮忙修改一下我的代码，另外程序运行速度比较慢，请帮忙优化一下，提高代码速度，感谢感谢！

3190496160

Sub 多条件汇总()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("动态工作量查询")
    r = .Cells(Rows.Count, 4).End(xlUp).Row
    If r < 9 Then MsgBox "动态工作量查询为空！": End
    ar = .Range("d8:o" & r)
End With
ReDim br(1 To UBound(ar), 1 To 100)
br(1, 1) = "序号"
br(1, 2) = "器具" & Chr(10) & "   姓名"
k = 1: y = 2
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" And ar(i, 2) <> "" Then
        t = d(ar(i, 1))
        If t = "" Then
            k = k + 1
            d(ar(i, 1)) = k
            t = k
            br(k, 1) = k - 1
            br(k, 2) = ar(i, 1)
        End If
        lh = d(ar(i, 2))
        If lh = "" Then
            y = y + 1
            d(ar(i, 2)) = y
            lh = y
            br(1, y) = ar(i, 2)
        End If
        br(t, lh) = br(t, lh) + ar(i, 7)
    End If
Next i
y = y + 1
br(1, y) = "实物工作量合计"
br(1, y + 1) = "系数工作量合计"
br(1, y + 2) = "姓名"
br(1, y + 3) = "系数排名"
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        t = d(ar(i, 1))
        br(t, y) = br(t, y) + ar(i, 7)
        br(t, y + 1) = br(t, y + 1) + ar(i, 8)
        br(t, y + 2) = ar(i, 1)
    End If
Next i
With Sheet4
    .UsedRange.Offset(5) = Empty
    .[d6].Resize(k, y + 3) = br
    For i = 7 To k + 5
        .Cells(i, y + 6).FormulaR1C1 = "=RANK(RC[-2],R7C10:R" & k + 5 & "C10)"
    Next i
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

longyi999 发表于 2024-11-11 16:45
老师，代码中.Cells(i, y + 6).FormulaR1C1 = "=RANK(RC[-2],R7C10:R" & k + 5 & "C10)" 排名还是有问题 ...

ykcbf1100

你大量的使用单元格处理数据不慢才怪，改用数组啊。
你这代码没有改的必要，还不如提出实际需求，重新写一个为好。

z865593849

这种代码没必要优化，重写吧

longyi999

ykcbf1100 发表于 2024-11-10 20:10
你大量的使用单元格处理数据不慢才怪，改用数组啊。
你这代码没有改的必要，还不如提出实际需求，重新写一 ...

我这也是高手帮我写的，老师能帮我改下了么，就是sheet4表根据sheet7的内容进行查找、汇总、求和、另外并根据系数工作量合计排个名次。感谢！

3190496160

排名错误表.rar (56.89 KB, 下载次数: 4)

2024-11-11 09:44 上传

点击文件名下载附件

longyi999

3190496160 发表于 2024-11-11 09:44

老师，代码中.Cells(i, y + 6).FormulaR1C1 = "=RANK(RC[-2],R7C10:R" & k + 5 & "C10)" 排名还是有问题，RANK(BF7,$J$7:$J$31)，固定在J列了，而不是变化的

3190496160

longyi999 发表于 2024-11-11 16:45
老师，代码中.Cells(i, y + 6).FormulaR1C1 = "=RANK(RC[-2],R7C10:R" & k + 5 & "C10)" 排名还是有问题 ...

这句代码确实还有点问题，等有时间再修改一下吧

longyi999

3190496160 发表于 2024-11-11 17:03

好了。感谢大神，帮我解困！祝您心想事成，财源滚滚！