修复 Excel 宏以计算和汇总正确的行
Fixing Excel macro to count and summarize correct rows
我有一个 excel 文档，最初有 1 个标签，如下所示：
当我运行“master”宏时，它：
- 删除一些列
- 在顶部添加一行数字
- 添加一个名为 Output
的空白 sheet
- 获取原始数据选项卡，将其粘贴到“输出”选项卡并将其从宽转换为长（所有这些宏都完美运行）
- 最后它计算输出选项卡中的行块并插入两行带有摘要统计信息，如下所示：
到目前为止，这主要是我想要的行为。 65 在正确的位置。我希望在它的正下方显示“91”（到目前为止整列的总和），但至少 65 是正确的。
更紧迫的问题是下面的一些摘要行。例如，紧接着的摘要行在它应该出现的位置有 91，但它上面有一个不正确的空白：
然后下面的汇总行应该是 100,100 而不是 0,91：
之后的摘要行应该是 100,100，但实际上是 0,191！
我不太熟悉将 excel VBA 粘贴到堆栈上（通常在事物的 R 侧），但我认为问题出在这个宏的某个地方：
'ADD THE EXCEL FORMATTING********************************************************************
Sub format()
Dim lastRow As Long, rawRow As Long, rawCol As Long, writeRow As Long
'count total number of rows
lastRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row
'set starting places, first row with info is 3 while trouble shooting but 2 normally
x = 1
Row = 2
'Set sum counter to add up all no cost center values
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
'Start loop*****************************************************************************
'where it finds ROW = 20 inserts 2 rows below
For x = 1 To lastRow
'For x = 1 To 66
If Cells(Row, 11) = 20 Then
Rows(Row + 1).EntireRow.Insert
Rows(Row + 1).EntireRow.Insert
' Cells(Row + 1, 8).NumberFormat = "0%"
' Cells(Row + 1, 9).NumberFormat = "0%"
' Cells(Row + 1, 10).NumberFormat = "0%"
' Cells(Row + 2, 8).NumberFormat = "0%"
' Cells(Row + 2, 9).NumberFormat = "0%"
' Cells(Row + 2, 10).NumberFormat = "0%"
Cells(Row + 1, 7) = "Total Research Effort"
Cells(Row + 2, 7) = "Total Effort"
' insert reseach effort previous and actual
Cells(Row + 1, 8) = total_REb_sum
Cells(Row + 1, 9) = total_REp_sum
Cells(Row + 1, 10) = total_RE_sum
' insert total effort previous and actual
Cells(Row + 2, 8) = total_Eb_sum
Cells(Row + 2, 9) = total_Ep_sum
Cells(Row + 2, 10) = total_Ep_sum
'2 rows are added in this step because the new row jsut added in this step adds to the increment
Row = Row + 2
'reset sum to 0 because I moved to a new person
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
ElseIf Row >= 7 And Row <= 20 Then
total_RE_sum = total_RE_sum + Cells(Row, 10).Value 'total research effort actual
total_REp_sum = total_REp_sum + Cells(Row, 9).Value 'total research effort previous
total_REb_sum = total_REb_sum + Cells(Row, 8).Value 'total research effort budgeted
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
Else
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
End If
Next
End Sub
我完全不确定宏哪里出了问题，我不是原作者。谢谢！
备注：
我只是附加了看起来像陈述的解决方案，个人认为我认为整个逻辑需要修改。陈述的问题可以用更好的措辞让其他人在不需要下载文件的情况下理解逻辑。关于预处理中使用的选择，请查看此主题 avoid selection。底线：你是对的，模块格式是需要修复的，我改变了它的整个逻辑
演示：
代码：
Sub format_alternative()
Const NumRowsToAppend As Long = 20
Dim NumTotalRows As Long
Dim TotalCyclesToPerfom As Long
Dim CounterCyclesToPerform As Long
Dim NumRowsAppended As Long
Dim IsFixLast As Boolean
Dim NumRowResearchEffort As Long
Dim NumRowTotalEffort As Long
With Sheets("Output")
NumTotalRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
TotalCyclesToPerfom = NumTotalRows / NumRowsToAppend
'It means for last cycle there are not enough rows to do it as for others, so we need to append for that
IsFixLast = IIf(NumTotalRows Mod NumRowsToAppend <> 0, True, False)
NumRowsAppended = 1
For CounterCyclesToPerform = 1 To TotalCyclesToPerfom
If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True Then ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
'I'm going to leave this scenario for you to try to understand the logic and when it happens you fix it accordingly
Else ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
NumRowResearchEffort = (NumRowsToAppend * CounterCyclesToPerform) + 1 + NumRowsAppended
NumRowTotalEffort = (NumRowsToAppend * CounterCyclesToPerform) + 2 + NumRowsAppended
End If ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
.Rows(NumRowResearchEffort & ":" & NumRowTotalEffort).Insert
.Cells(NumRowResearchEffort, 7) = "Total Research Effort"
.Cells(NumRowTotalEffort, 7) = "Total Effort"
' insert reseach effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowResearchEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - 11 & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - 11 & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - 11 & ":J" & NumRowResearchEffort - 1 & ")"
' insert total effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowTotalEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - NumRowsToAppend & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - NumRowsToAppend & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - NumRowsToAppend & ":J" & NumRowResearchEffort - 1 & ")"
NumRowsAppended = NumRowsAppended + 2
Next CounterCyclesToPerform
End With
End Sub
我有一个 excel 文档，最初有 1 个标签，如下所示：
当我运行“master”宏时，它：
- 删除一些列
- 在顶部添加一行数字
- 添加一个名为 Output 的空白 sheet
- 获取原始数据选项卡，将其粘贴到“输出”选项卡并将其从宽转换为长（所有这些宏都完美运行）
- 最后它计算输出选项卡中的行块并插入两行带有摘要统计信息，如下所示：
到目前为止，这主要是我想要的行为。 65 在正确的位置。我希望在它的正下方显示“91”（到目前为止整列的总和），但至少 65 是正确的。
更紧迫的问题是下面的一些摘要行。例如，紧接着的摘要行在它应该出现的位置有 91，但它上面有一个不正确的空白：
然后下面的汇总行应该是 100,100 而不是 0,91：
之后的摘要行应该是 100,100，但实际上是 0,191！
我不太熟悉将 excel VBA 粘贴到堆栈上（通常在事物的 R 侧），但我认为问题出在这个宏的某个地方：
'ADD THE EXCEL FORMATTING********************************************************************
Sub format()
Dim lastRow As Long, rawRow As Long, rawCol As Long, writeRow As Long
'count total number of rows
lastRow = Sheets("Output").Cells(Rows.Count, 1).End(xlUp).Row
'set starting places, first row with info is 3 while trouble shooting but 2 normally
x = 1
Row = 2
'Set sum counter to add up all no cost center values
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
'Start loop*****************************************************************************
'where it finds ROW = 20 inserts 2 rows below
For x = 1 To lastRow
'For x = 1 To 66
If Cells(Row, 11) = 20 Then
Rows(Row + 1).EntireRow.Insert
Rows(Row + 1).EntireRow.Insert
' Cells(Row + 1, 8).NumberFormat = "0%"
' Cells(Row + 1, 9).NumberFormat = "0%"
' Cells(Row + 1, 10).NumberFormat = "0%"
' Cells(Row + 2, 8).NumberFormat = "0%"
' Cells(Row + 2, 9).NumberFormat = "0%"
' Cells(Row + 2, 10).NumberFormat = "0%"
Cells(Row + 1, 7) = "Total Research Effort"
Cells(Row + 2, 7) = "Total Effort"
' insert reseach effort previous and actual
Cells(Row + 1, 8) = total_REb_sum
Cells(Row + 1, 9) = total_REp_sum
Cells(Row + 1, 10) = total_RE_sum
' insert total effort previous and actual
Cells(Row + 2, 8) = total_Eb_sum
Cells(Row + 2, 9) = total_Ep_sum
Cells(Row + 2, 10) = total_Ep_sum
'2 rows are added in this step because the new row jsut added in this step adds to the increment
Row = Row + 2
'reset sum to 0 because I moved to a new person
total_RE_sum = 0 'total research effort actual
total_REp_sum = 0 'total research effort previous
total_REb_sum = 0 'total research effort budgeted
total_E_sum = 0 'total effort actual
total_Ep_sum = 0 'total effort previous
total_Eb_sum = 0 'total effort budgeted
ElseIf Row >= 7 And Row <= 20 Then
total_RE_sum = total_RE_sum + Cells(Row, 10).Value 'total research effort actual
total_REp_sum = total_REp_sum + Cells(Row, 9).Value 'total research effort previous
total_REb_sum = total_REb_sum + Cells(Row, 8).Value 'total research effort budgeted
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
Else
total_E_sum = total_E_sum + Cells(Row, 10).Value 'total effort actual
total_Ep_sum = total_Ep_sum + Cells(Row, 9).Value 'total effort previous
total_Eb_sum = total_Eb_sum + Cells(Row, 8).Value 'total effort budgeted
Row = Row + 1
End If
Next
End Sub
我完全不确定宏哪里出了问题，我不是原作者。谢谢！
备注：
我只是附加了看起来像陈述的解决方案，个人认为我认为整个逻辑需要修改。陈述的问题可以用更好的措辞让其他人在不需要下载文件的情况下理解逻辑。关于预处理中使用的选择，请查看此主题 avoid selection。底线：你是对的，模块格式是需要修复的，我改变了它的整个逻辑
演示：
代码：
Sub format_alternative()
Const NumRowsToAppend As Long = 20
Dim NumTotalRows As Long
Dim TotalCyclesToPerfom As Long
Dim CounterCyclesToPerform As Long
Dim NumRowsAppended As Long
Dim IsFixLast As Boolean
Dim NumRowResearchEffort As Long
Dim NumRowTotalEffort As Long
With Sheets("Output")
NumTotalRows = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
TotalCyclesToPerfom = NumTotalRows / NumRowsToAppend
'It means for last cycle there are not enough rows to do it as for others, so we need to append for that
IsFixLast = IIf(NumTotalRows Mod NumRowsToAppend <> 0, True, False)
NumRowsAppended = 1
For CounterCyclesToPerform = 1 To TotalCyclesToPerfom
If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True Then ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
'I'm going to leave this scenario for you to try to understand the logic and when it happens you fix it accordingly
Else ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
NumRowResearchEffort = (NumRowsToAppend * CounterCyclesToPerform) + 1 + NumRowsAppended
NumRowTotalEffort = (NumRowsToAppend * CounterCyclesToPerform) + 2 + NumRowsAppended
End If ' 1. If CounterCyclesToPerform = TotalCyclesToPerfom And IsFixLast = True
.Rows(NumRowResearchEffort & ":" & NumRowTotalEffort).Insert
.Cells(NumRowResearchEffort, 7) = "Total Research Effort"
.Cells(NumRowTotalEffort, 7) = "Total Effort"
' insert reseach effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowResearchEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - 11 & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - 11 & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowResearchEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - 11 & ":J" & NumRowResearchEffort - 1 & ")"
' insert total effort previous and actual. I changed for a formula so it's easier for the user to see what's going on calculations
.Cells(NumRowTotalEffort, 8).Formula = "=SUM(H" & NumRowResearchEffort - NumRowsToAppend & ":H" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 9).Formula = "=SUM(I" & NumRowResearchEffort - NumRowsToAppend & ":I" & NumRowResearchEffort - 1 & ")"
.Cells(NumRowTotalEffort, 10).Formula = "=SUM(J" & NumRowResearchEffort - NumRowsToAppend & ":J" & NumRowResearchEffort - 1 & ")"
NumRowsAppended = NumRowsAppended + 2
Next CounterCyclesToPerform
End With
End Sub