我有一组数据，可为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%
答案 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获得想要的结果。我运行了最初发布的代码，以在“总计”行之后添加空白行。然后，我对公式进行了以下操作：