Question

我有以下代码，这些论坛的撰稿人为我写的，我已经修改它做我想要的。我知道它可以缩短，但我的VBA技能非常基础。

代码添加了另一行的摘要。

谢谢。

Public Sub SumCages()
Dim current_row, summary_row, item_total As Integer

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 7) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 7)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 7))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 8) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 8) = Sheet8.Cells(current_row, 7) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 8) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 11) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 11)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 11))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 12) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 12) = Sheet8.Cells(current_row, 11) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 12) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 15) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 15)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 15))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 16) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 16) = Sheet8.Cells(current_row, 15) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 16) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 19) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 19)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 19))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 20) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 20) = Sheet8.Cells(current_row, 19) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 20) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 23) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 23)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 23))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 24) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 24) = Sheet8.Cells(current_row, 23) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 24) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 27) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 27)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 27))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 28) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 28) = Sheet8.Cells(current_row, 27) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 28) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 31) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 31)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 31))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 32) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 32) = Sheet8.Cells(current_row, 31) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 32) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 35) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 35)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 35))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 36) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 36) = Sheet8.Cells(current_row, 35) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 36) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 39) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 39)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 39))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 40) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 40) = Sheet8.Cells(current_row, 39) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 40) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 43) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 43)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 43))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 44) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 44) = Sheet8.Cells(current_row, 43) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 44) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 47) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 47)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 47))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 48) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 48) = Sheet8.Cells(current_row, 47) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 48) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 51) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 51)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 51))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 52) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 52) = Sheet8.Cells(current_row, 51) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 52) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 55) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 55)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 55))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 56) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 56) = Sheet8.Cells(current_row, 55) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 56) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 59) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 59)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 59))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 60) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 60) = Sheet8.Cells(current_row, 59) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 60) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 63) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 63)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 63))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 64) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 64) = Sheet8.Cells(current_row, 63) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 64) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 67) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 67)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 67))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 68) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 68) = Sheet8.Cells(current_row, 67) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 68) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 71) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 71)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 71))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 72) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 72) = Sheet8.Cells(current_row, 71) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 72) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 75) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 75)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 75))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 76) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 76) = Sheet8.Cells(current_row, 75) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 76) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 79) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 79)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 79))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 80) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 80) = Sheet8.Cells(current_row, 79) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 80) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 83) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 83)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 83))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 84) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 84) = Sheet8.Cells(current_row, 83) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 84) = item_total

current_row = 45
summary_row = 44
While Sheet8.Cells(current_row, 87) <> ""
  If IsNumeric(Sheet8.Cells(current_row, 87)) Then
    item_total = item_total + Val(Sheet8.Cells(current_row, 87))
  Else
    summary_row = summary_row + 1 ' Advance summary_row
    If item_total > 0 Then
      Sheet8.Cells(summary_row, 88) = item_total ' Display total
      current_row = current_row - 1 ' Correct advancement
    Else
      Sheet8.Cells(summary_row, 88) = Sheet8.Cells(current_row, 87) ' Copy label
    End If
    item_total = 0 ' Reset item_total
  End If
  current_row = current_row + 1 ' Advance current_row
Wend
Sheet8.Cells(summary_row + 1, 88) = item_total

End Sub

Answer 1

可能有更好的方法来加强它，使其更加面向对象。我无法遵循更改迭代器变量的逻辑而不尝试重新创建您不与我们共享的工作表结构，因此，现在这是未经测试的，可能需要进行一些调整。

无论如何，它应该是一个好的起点。上面的代码是一个可以在子例程中合并的完美示例。

首先，在你的主例程中建立一个循环。看起来你是从第7列开始，然后每隔第4列踩到87：

Sub TestMain()
Dim i As Long
For i = 7 To 87 Step 4      'iterate every 4th column from 7 to 87
    DoStuff i               'call a subroutine, and pass this column# as an argument
Next
End Sub

现在，将所有其余的操作代码放在子程序中，该子程序接受i作为必需参数myCol：

Sub DoStuff(myCol As Long)
'
' This subroutine performs some manipulation 
'
Dim currentRow As Long
Dim summaryRow As Long
Dim cl As Range

currentRow = 45
summaryRow = 44
Set cl = Sheet8.Cells(currentRow, myCol)

While cl <> ""
    If IsNumeric(cl) Then
        item_total = item_total + Val(cl)
    Else
        summary_row = summary_row + 1                 ' Advance summary_row
        If item_total > 0 Then
            Sheet8.Cells(summary_row, myCol + 1) = item_total ' Display total
            current_row = current_row - 1 ' Correct advancement
        Else
            Sheet8.Cells(summary_row, myCol + 1) = cl ' Copy label
        End If
        item_total = 0 ' Reset item_total
    End If
    currentRow = currentRow + 1                       ' Advance current_row
    Set cl = Sheet8.Cells(currentRow, myCol)  
Wend
Sheet8.Cells(summary_row + 1, myCol + 1) = item_total

End Sub

如何清理VBA代码

1 个答案: