VBA在总行下方添加计算总百分比的行

时间:2019-04-19 01:53:04

标签: excel vba

我有一组数据,可为3个类别的分组中的每次更改计算总计。我需要在合计行下方插入一行以计算相同三个字段的合计百分比。分组中的每次更改都有不同数量的行。

我已使用以下代码插入行:

Sub insert percent row()
Dim c As Range

For Each c In Range("Q1:Q100")
  If c.Value Like "*Total*" Then
    c.Offset(1, 0).EntireRow.Insert
  End If
Next c

End Sub

我在下一步该怎么做。

我的总数在Q列中,而我的三个计算单元格在Y,Z和AA列中。我需要在其总数下方插入Y / Y + Z + AA,Z / Y + Z + AA,AA / Y + Z + AA,并以百分比格式显示。理想情况下,我希望它看起来像这样:

    A        Q               Y    Z    AA
    Item 1   Group 1         1
    Item 2   Group 1         1
    Item 3   Group 1              2
    Item 4   Group 1              2
    Item 5   Group 1                   4
             Group 1 Total   2    4    4
             Group 1 Percent 20%  40%  40%

2 个答案:

答案 0 :(得分:0)

尝试此代码。假设您的总计在X列中。

Sub Macro1()

    Dim EmptyFields As Integer
    Dim MyRow As Integer
    Dim GrandTotal As Integer

    Dim Percent1, Percent2, Percent3 As Double
    EmptyFields = 0
    MyRow = 1

    ' if 3 continuous cells are empty, we should assume that the dataset is over
    Do While EmptyFields < 3

        Range("X" & MyRow).Select

        ' if we see Total in column X, we should get grand total of that row
        ' and caculate percentages. Then, we add a new row below it
        ' and store the percentages in the new row
        If LCase(Range("X" & MyRow).Text) = "total" Then
            GrandTotal = Range("Y" & MyRow).Value + Range("Z" & MyRow).Value + Range("AA" & MyRow).Value
            Percent1 = Round(Range("Y" & MyRow).Value * 100 / GrandTotal)
            Percent2 = Round(Range("Z" & MyRow).Value * 100 / GrandTotal)
            Percent3 = Round(Range("AA" & MyRow).Value * 100 / GrandTotal)

            Range("X" & MyRow + 1).Select
            Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove
            Range("X" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = "Percent"
            Range("Y" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent1) & "%"
            Range("Z" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent2) & "%"
            Range("AA" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent3) & "%"

            EmptyFields = 0
            MyRow = MyRow + 1

        ' if cell is empty, increment empty fields variable
        ElseIf Len(Trim(Range("X" & MyRow).Text)) = 0 Then
            EmptyFields = EmptyFields + 1
        Else
            EmptyFields = 0
        End If

        MyRow = MyRow + 1
    Loop

End Sub

根据更新的要求,尝试以下代码:

Sub Macro1()

    Dim EmptyFields, MyRow, GrandTotal As Integer
    Dim Percent1, Percent2, Percent3 As Double
    Dim TotalLabel As String
    EmptyFields = 0
    MyRow = 1

    ' if 3 continuous cells are empty, we should assume that the dataset is over
    Do While EmptyFields < 3

        Range("Q" & MyRow).Select
        TotalLabel = Range("Q" & MyRow).Text

        ' if we see Total in column X, we should get grand total of that row
        ' and caculate percentages. Then, we add a new row below it
        ' and store the percentages in the new row
        If InStr(LCase(TotalLabel), "total") > 0 Then
            GrandTotal = Range("Y" & MyRow).Value + Range("Z" & MyRow).Value + Range("AA" & MyRow).Value
            Percent1 = Round(Range("Y" & MyRow).Value * 100 / GrandTotal)
            Percent2 = Round(Range("Z" & MyRow).Value * 100 / GrandTotal)
            Percent3 = Round(Range("AA" & MyRow).Value * 100 / GrandTotal)

            Range("Q" & MyRow + 1).Select
            Selection.EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove
            Range("Q" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Replace(LCase(TotalLabel), "total", "Percent")
            Range("Y" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent1) & "%"
            Range("Z" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent2) & "%"
            Range("AA" & MyRow + 1).Select
            ActiveCell.FormulaR1C1 = Str(Percent3) & "%"

            EmptyFields = 0
            MyRow = MyRow + 1

        ' if cell is empty, increment empty fields variable
        ElseIf Len(Trim(Range("Q" & MyRow).Text)) = 0 Then
            EmptyFields = EmptyFields + 1
        Else
            EmptyFields = 0
        End If

        MyRow = MyRow + 1
    Loop

End Sub

答案 1 :(得分:0)

我最终没有通过VBA获得想要的结果。我运行了最初发布的代码,以在“总计”行之后添加空白行。然后,我对公式进行了以下操作:

  1. 在Q,Y,Z,AA后添加列
  2. 在R列中添加公式 = IF(Q2 =“”,OFFSET(Q2,-2,0)&“ Percent”,“ No”)
  3. 在AA栏中添加公式 = TEXT(IF(ISNUMBER(SEARCH(“ Percent”,R2)),Z1 /(Z1 + AB1 + AD1),“否”),“#0%”)
  4. 在AC列中添加公式 = TEXT(IF(ISNUMBER(SEARCH(“ Percent”,R2)),AB1 /(Z1 + AB1 + AD1),“否”),“#0%”)
  5. 在AE列中添加公式 = TEXT(IF(ISNUMBER(SEARCH(“ Percent”,R2)),AD1 /(Z1 + AB1 + AD1),“否”),“#0%”)
  6. 将所有公式转换为值
  7. 过滤R列中包含“百分比”的单元格
  8. 将“百分比”单元格拖放到Q列的空白单元格中
  9. 过滤掉AA列中的“否”单元格
  10. 将百分比单元格从AA拖放到Z列的空白单元格中
  11. 将AC中的百分比单元拖放到AB列中的空白单元中
  12. 将百分比单元格从AD拖放到AD列中的空白单元格
  13. 删除列R,AA,AC,AE