Question

尝试完成一次处理每3行的VBA。使用 rank 列的顺序，将值分配到接下来的三行，而不是每个单元超过最大值62并优先考虑最高等级。

示例数据：

这是我到目前为止所拥有的：

max_value = 62 For irow = 2 To 80 Step 3 set_value = .Cells(irow, 2).Value 'if value less than max, then assign value to highest rank If set_value < max_value Then toprank_value = .Range(.Cells(irow, 1), .Cells(irow + 3, 1)).Find(what:="1", LookIn:=xlValues).Address 'assign value to rank of 1 toprank_value.Offset(0, 2).Value = set_value GoTo NextIteration 'if not, distribute values across next 3 rows based on rank not going over max of 62 Else 'NEED HELP FOR CODE HERE 'NEED HELP FOR CODE HERE End If NextIteration: Next

感谢您向正确的方向努力，或者需要澄清。

Answer 1

假设您要分发的值始终位于3行中的第一行。它很丑，但似乎有效。

Sub distrib()

Set R1 = ActiveSheet.UsedRange 'Edit range if other data in sheet
T1 = R1

M = 62

For i = 2 To UBound(T1)
    If T1(i, 2) > 0 Then
        V = T1(i, 2)
        If V <= M Then
            For j = i To i + 2
                If T1(j, 1) = 1 Then
                    T1(j, 3) = V
                Else
                    T1(j, 3) = 0
                End If
            Next j
        Else
            A = M
            V = V - M
            If V > M Then
                B = M
                V = V - M
                If V > M Then
                    C = M
                Else
                    C = V
                End If
            Else
                B = V
                C = 0
            End If
            For j = i To i + 2
                Select Case T1(j, 1)
                    Case Is = 1
                        T1(j, 3) = A
                    Case Is = 2
                        T1(j, 3) = B
                    Case Is = 3
                        T1(j, 3) = C
                End Select
            Next j
        End If
    End If
Next i

For i = 2 To UBound(T1)
    Cells(i, 3) = T1(i, 3)
Next i

End Sub

VBA根据排名分配值

1 个答案: