[已解决]评分

abc153

对应名次评分.rar (2.24 KB, 下载次数: 3)

2015-5-3 17:18 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

as0810114

2015-5-3 19:38

Sub test()
    Dim brr(1 To 10000, 1 To 1)
    Dim irow, maxrow
    With Sheets("2")
        maxrow = .Cells(Rows.Count, "i").End(xlUp).Row
        For irow = 2 To maxrow
            brr(irow - 1, 1) = Sheets("3").[j1].Offset(.Range("i" & irow), 0) - (.Cells(irow, "K") = "破") * 5
        Next
        .Range("j2:J1000").ClearContents
        .[j2].Resize(maxrow) = brr
    End With
End Sub

跳转到最佳答案楼层

baksy

函数解决~
J2公式；
=VLOOKUP(I2,'3'!I$2:J$9,2,)+(K2="破")*5

abc153

baksy 发表于 2015-5-3 17:25
函数解决~
J2公式；
=VLOOKUP(I2,'3'!I$2:J$9,2,)+(K2="破")*5

谢谢，如何用VBA解决呢？

as0810114

Sub test()
Dim arr, brr(1 To 10000, 1 To 1)
Dim irow, a, maxrow
maxrow = Sheets("2").Cells(Rows.Count, "i").End(xlUp).Row
arr = Sheets("3").Range("I1").CurrentRegion
For a = 2 To maxrow
    For irow = 2 To UBound(arr)
        If Sheets("2").Cells(a, "i") = arr(irow, 1) Then
        k = k + 1
        brr(k, 1) = arr(irow, 2) - (Sheets("2").Cells(a, "K") = "破") * sheets("3").[k2]
        End If
    Next
Next
Sheets("2").Range("j2:J1000").ClearContents
Sheets("2").[j2].Resize(k) = brr
End Sub

as0810114

Sub test()
    Dim brr(1 To 10000, 1 To 1)
    Dim irow, maxrow
    With Sheets("2")
        maxrow = .Cells(Rows.Count, "i").End(xlUp).Row
        For irow = 2 To maxrow
            brr(irow - 1, 1) = Sheets("3").[j1].Offset(.Range("i" & irow), 0) - (.Cells(irow, "K") = "破") * 5
        Next
        .Range("j2:J1000").ClearContents
        .[j2].Resize(maxrow) = brr
    End With
End Sub