Cómo limpiar un código VBA [cerrado]

I have the following code that a contributor to these forums wrote for me, I've modified it to do what I want. I know it can be shortened, but my VBA skills are extremely basic.

The code adds a summary of another row.

Gracias.

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

preguntado el 04 de septiembre de 13 a las 02:09

This is a classic example of a useless comment: "current_row = current_row + 1 ' Advance current_row " -

You've got about 20 different While...Wend blocks which are all essentially identical in structure. This could easily be put in to a subroutine that would clean up the code, immensely. -

1 Respuestas

There are probably better ways to tighten this up and make it a little more object-oriented. I couldn't follow the logic of changing your iterator variable without trying to recreate a worksheet structure that you didn't share with us, so, for now this is untested, and may need some tweaking.

In any case, it should be a good place to start. This above code is a perfect example of something that can be consolidated in a subroutine.

First, in your main routine establish a loop. It looks like you are starting at column 7, and then stepping every 4th column through 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

Now, put all the rest of the operative code in a subroutine, which accepts i as an required argument, 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

Respondido el 04 de Septiembre de 13 a las 14:09

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.