0

我有这些论坛的贡献者为我写的以下代码，我已经对其进行了修改以做我想做的事。我知道它可以缩短，但我的 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
4

1 回答 1

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
于 2013-09-04T01:50:14.620 回答