excel 计算100%比率的宏

pes8fvy9  于 2023-10-22  发布在  其他
关注(0)|答案(1)|浏览(99)

我写的宏代码,但给错误的输出时,适用于我的Excel工作表.
我需要做的事情的背景:
初始表

第一步:

在Excel表格中填写E2至I5列
绿色行:
单元格E2的示例公式=D2*(100%+$A$3-$A$5)
蓝色行:
单元格E4的示例公式=D4+D3-E3

步骤1后的结果

步骤2:
如果有负值,我们必须用“0”代替它。

步骤2后的结果

步骤3:H列和I列中的值之和大于100,因此我们只需将最高的数字替换为100

最终结果

任何帮助纠正这个代码或作出新的逻辑将不胜感激。

编码

Sub ApplyFormulasWithConditions()
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim sumPositives As Double
    Dim maxVal As Double
   
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your actual sheet name
   
    ' Loop through the table and apply the formulas
    For i = 2 To 5 ' Rows 2 to 5
        For j = 5 To 9 ' Columns e to i
            If j = 6 Then
                ' Formula for F2
                ws.Cells(i, j).Formula = "=$E$" & i & "*(1+$B$3-$B$5)"
            ElseIf j = 7 Then
                ' Formula for F3
                ws.Cells(i, j).Formula = "=$E$" & i & "*(1+$B$3+$B$5)"
            Else
                ' Formulas for F4 to Q5
                ws.Cells(i, j).Formula = "=$E$" & i & "+E" & i & "-F" & i & ""
            End If
           
            ' Apply condition 1: If the value is negative, make it zero
            If ws.Cells(i, j).Value < 0 Then
                ws.Cells(i, j).Value = 0
            End If
           
            ' Apply condition 2: If the value is more than 100, calculate the sum of positive values and divide by the sum
            If ws.Cells(i, j).Value > 100 Then
                sumPositives = 0
                For k = 6 To 17 ' Calculate the sum of positive values in the same row
                    If ws.Cells(i, k).Value > 0 Then
                        sumPositives = sumPositives + ws.Cells(i, k).Value
                    End If
                Next k
                If sumPositives > 0 Then
                    ws.Cells(i, j).Value = ws.Cells(i, j).Value * (sumPositives / ws.Cells(i, j).Value)
                End If
            End If
           
            ' Apply condition 3: If the maximum value in a column is greater than 100, set all values to 100 and the others to zero
            If j = 6 Then
                maxVal = Application.WorksheetFunction.Max(ws.Range(ws.Cells(2, j), ws.Cells(5, j)))
                If maxVal > 100 Then
                    For k = 2 To 5 ' Rows 2 to 5
                        ws.Cells(k, j).Value = Application.WorksheetFunction.Min(100, ws.Cells(k, j).Value)
                    Next k
                End If
            End If
        Next j
    Next i
End Sub
91zkwejq

91zkwejq1#

你为什么不改一下配方呢?

E2 = IF(D2*(100%+$A$3-$A$5)<0,0,IF(D2*(100%+$A$3-$A$5)>1,1,D2*(100%+$A$3-$A$5)))

E4 = IF(D2*(D4+D3-E3)<0,0,IF(D2*(D4+D3-E3)>1,1,D2*(D4+D3-E3)))

相关问题