求助量化汇总

longwin

戎马书生222 发表于 2024-10-8 09:52
请问这个，先汇总早读，早后，晚4的和，该如何循环？

谢谢大侠

Sub test()
arr = [a1].CurrentRegion
For i = 3 To UBound(arr)
    For j = 3 To UBound(arr, 2) - 4 Step 3
        For m = 1 To 3
            arr(i, UBound(arr, 2) - 4 + m) = arr(i, UBound(arr, 2) - 4 + m) + arr(i, j + m - 1)
        Next
    Next
Next
[a1].CurrentRegion = arr
End Sub

ykcbf1100

戎马书生222 发表于 2024-10-8 09:54
11班，这个应该是10-2*2=6分

你这样算啊，那改一下吧。

longwin

戎马书生222 发表于 2024-10-8 09:52
请问这个，先汇总早读，早后，晚4的和，该如何循环？

谢谢大侠

量化计分也加上了：
Sub test()
Range("X3:AA26").Value = ""
arr = [a1].CurrentRegion
For i = 3 To UBound(arr)
lh = 0
    For j = 3 To UBound(arr, 2) - 4 Step 3
        For m = 1 To 3
            arr(i, UBound(arr, 2) - 4 + m) = arr(i, UBound(arr, 2) - 4 + m) + arr(i, j + m - 1)
        Next
    Next
    For n = UBound(arr, 2) - 3 To UBound(arr, 2) - 1
        If arr(i, n) < 4 Then lh = lh + (arr(i, n) - 4) * 2
    Next
    arr(i, n) = 10 + lh
    If arr(i, n) < 0 Then arr(i, n) = 0
Next
[a1].CurrentRegion = arr
End Sub

longwin

附件供参考....

戎马书生222

longwin 发表于 2024-10-8 10:22
附件供参考....

思考半天，用了个最笨的办法


Sub test()
Range("x3:aa27").ClearContents
arr = [a1].CurrentRegion.Value

For m = 3 To UBound(arr)
    p = 3
       For b = 24 To 26
      
            For n = p To 23 Step 3
                 arr(m, b) = arr(m, b) + arr(m, n)
            Next
            p = p + 1
    Next
Next
For i = 3 To UBound(arr)
     lh = 0
    For j = 24 To UBound(arr, 2) - 1
        If arr(i, j) < 4 Then
            lh = lh + (arr(i, j) - 4) * 2
        End If
    Next
    If 10 + lh < 0 Then
        arr(i, UBound(arr, 2)) = 0
    Else
        arr(i, UBound(arr, 2)) = 10 + lh
    End If
Next
Range("x3:aa27").ClearContents
[a1].CurrentRegion = arr
End Sub

戎马书生222

longwin 发表于 2024-10-8 10:22
附件供参考....

感谢。用了最笨的办法

Sub test()
Range("x3:aa27").ClearContents
arr = [a1].CurrentRegion.Value

For m = 3 To UBound(arr)
    p = 3
       For b = 24 To 26
      
            For n = p To 23 Step 3
                 arr(m, b) = arr(m, b) + arr(m, n)
            Next
            p = p + 1
    Next
Next
For i = 3 To UBound(arr)
     lh = 0
    For j = 24 To UBound(arr, 2) - 1
        If arr(i, j) < 4 Then
            lh = lh + (arr(i, j) - 4) * 2
        End If
    Next
    If 10 + lh < 0 Then
        arr(i, UBound(arr, 2)) = 0
    Else
        arr(i, UBound(arr, 2)) = 10 + lh
    End If
Next
Range("x3:aa27").ClearContents
[a1].CurrentRegion = arr
End Sub

戎马书生222

ykcbf1100 发表于 2024-10-8 10:13
你这样算啊，那改一下吧。

这个还是不对。我参考了“longwin”的方法。谢谢了

ykcbf1100

戎马书生222 发表于 2024-10-8 10:35
这个还是不对。我参考了“longwin”的方法。谢谢了

行吧。。。。

不规则结构

Sub dsgf()
    For i = 2 To 25
        c = 0
        For j = 2 To 4
            If Cells(i, j) < 4 Then c = c + (4 - Cells(i, j)) * 2 '从扣分入手
        Next
        Cells(i, 5) = 10 - c
        If c > 10 Then Cells(i, 5) = 0 '处理低于0分的情况
    Next
End Sub