Como simplificar o código que combina informações e adiciona valores para determinadas colunas?

Question

Estou reformulando alguns códigos do VBA que foram feitos 15 anos atrás e que alguém criou. Eu tenho que adicionar mais código para atender às nossas necessidades, mas eu excedi a quantidade de código permitido para ser executado.

Eu tenho um produto na coluna "AF" com os valores que preciso para combinar juntos na coluna "AH" "AL" e "AN" principalmente. O restante das colunas não precisa ser adicionado. Faça com que ele insira o intervalo de dados em uma parte diferente da planilha.

A primeira parte do Código Limpa os dados anteriores para que sejam limpos.

A segunda parte do código procura um Mosaico na Coluna AF e procura as linhas 41-60 pelo mesmo bloco depois de encontrar outro (ou se não o fizer) ele coloca em alguma linha na coluna A e em alguma linha no o intervalo 41-60. Isso se repete várias vezes até chegar a todas as linhas. Este funciona, mas uma vez que vai para 41-62 adicionando linhas adicionais, não funciona.

Private Sub FloorWallTileCombo_Click()
Dim TileSearch As String
Dim TotalPrice As Double, TotalSF As Double, TotalSurCap As Double, TotalCorCap As Double
'Dim TotalLF As Double, TotalAccentPcs As Double
For j = 41 To 60
ThisWorkbook.Worksheets("Breakdown").Cells(j, "A") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "D") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "E") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "F") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(j, "H") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "I") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "J") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "K") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(j, "O") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "P") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "Q") = ""
ThisWorkbook.Worksheets("Breakdown").Cells(j, "R") = ""

ThisWorkbook.Worksheets("Breakdown").Cells(8, "B") = "Hand over the calculator, friends don’t let friends derive drunk."
ThisWorkbook.Worksheets("Breakdown").Cells(11, "B") = " "
'Application.ScreenUpdating = False

Next

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(41, "AF") 'starting Point from import
If TileSearch <> "" Then
    For i = 41 To 60
        If TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AF") Then
        'this line shouldnt change once number is in
        'catch = i
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "O") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AB")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "P") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AC")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "Q") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AD")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "A") = TileSearch
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "H") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AK")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "J") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AM")
        'need for price pulling
        TotalPrice = TotalPrice + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AG")
        TotalSF = TotalSF + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AH")
       'this is for bullnose count
        TotalSurCap = TotalSurCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AL")
        TotalCorCap = TotalCorCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AQ")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "D") = TotalPrice
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "I") = TotalSurCap
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "K") = TotalCorCap
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "R") = TotalSF
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "E") = ThisWorkbook.Worksheets("Breakdown").Cells(41, "V")
        ThisWorkbook.Worksheets("Breakdown").Cells(41, "F") = ThisWorkbook.Worksheets("Breakdown").Cells(41, "U")
         End If
    Next i
End If

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

    TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(42, "AF")
    If TileSearch <> "" And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(41, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(43, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(44, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(45, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(46, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(47, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(48, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(49, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(50, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(51, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(52, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(53, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(54, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(55, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(56, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(57, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(58, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(59, "A") _
And TileSearch <> ThisWorkbook.Worksheets("Breakdown").Cells(60, "A") Then
    For i = 41 To 60
        If TileSearch = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AF") Then
        'this line shouldnt change once number is in
        'catch = i
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "O") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AB")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "P") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AC")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "Q") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AD")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "A") = TileSearch
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "H") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AK")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "J") = ThisWorkbook.Worksheets("Breakdown").Cells(i, "AM")
        'need for price pulling
        TotalPrice = TotalPrice + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AG")
        TotalSF = TotalSF + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AH")
       'this is for bullnose count
        TotalSurCap = TotalSurCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AL")
        TotalCorCap = TotalCorCap + ThisWorkbook.Worksheets("Breakdown").Cells(i, "AQ")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "D") = TotalPrice
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "I") = TotalSurCap
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "K") = TotalCorCap
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "R") = TotalSF
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "E") = ThisWorkbook.Worksheets("Breakdown").Cells(42, "V")
        ThisWorkbook.Worksheets("Breakdown").Cells(42, "F") = ThisWorkbook.Worksheets("Breakdown").Cells(42, "U")
         End If
    Next i
End If

Editar: 3-23  Pergunta Respondida removida questão de erro de loop duplo.

    

Answer 1

Alterei a parte que você precisava por meio da introdução de uma variável booleana bFlag .

Private Sub FloorWallTileCombo_Click()
Dim TileSearch As String
Dim TotalPrice As Double, TotalSF As Double, TotalSurCap As Double, TotalCorCap As Double
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Breakdown")
Dim bFlag As Boolean

ws.Range("A41:A60").Value2 = vbNullString
ws.Range("D41:F60").Value2 = vbNullString
ws.Range("H41:K60").Value2 = vbNullString
ws.Range("O41:R60").Value2 = vbNullString

ws.Cells(8, "B") = "Hand over the calculator, friends don’t let friends derive drunk."
ws.Cells(11, "B") = " "

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ws.Cells(41, "AF") 'starting Point from import
If TileSearch <> "" Then
    For i = 41 To 60
        If TileSearch = ws.Cells(i, "AF") Then
            'this line shouldnt change once number is in
            ws.Range("O41:Q41").Value = ws.Range("AB" & i & ":AD" & i).Value
            ws.Cells(41, "A") = TileSearch
            ws.Cells(41, "H") = ws.Cells(i, "AK")
            ws.Cells(41, "J") = ws.Cells(i, "AM")
            'need for price pulling
            TotalPrice = TotalPrice + ws.Cells(i, "AG")
            TotalSF = TotalSF + ws.Cells(i, "AH")
            'this is for bullnose count
            TotalSurCap = TotalSurCap + ws.Cells(i, "AL")
            TotalCorCap = TotalCorCap + ws.Cells(i, "AQ")
            ws.Cells(41, "D") = TotalPrice
            ws.Cells(41, "I") = TotalSurCap
            ws.Cells(41, "K") = TotalCorCap
            ws.Cells(41, "R") = TotalSF
            ws.Cells(41, "E") = ws.Cells(41, "V")
            ws.Cells(41, "F") = ws.Cells(41, "U")
        End If
    Next 'i
End If

TotalPrice = 0
TotalSF = 0
TotalSurCap = 0
TotalCorCap = 0

TileSearch = ws.Cells(42, "AF")
For i = 43 To 60
    If Not TileSearch <> ws.Cells(i, "A") Then
        bFlag = True
        Exit For
    End If
Next

If TileSearch <> "" And TileSearch <> ws.Cells(41, "A") And bFlag = False Then
    For i = 41 To 60
        If TileSearch = ws.Cells(i, "AF") Then
            'this line shouldnt change once number is in
            ws.Range("O42:Q42").Value = ws.Range("AB" & i & ":AD" & i).Value
            ws.Cells(42, "A") = TileSearch
            ws.Cells(42, "H") = ws.Cells(i, "AK")
            ws.Cells(42, "J") = ws.Cells(i, "AM")
            'need for price pulling
            TotalPrice = TotalPrice + ws.Cells(i, "AG")
            TotalSF = TotalSF + ws.Cells(i, "AH")
            'this is for bullnose count
            TotalSurCap = TotalSurCap + ws.Cells(i, "AL")
            TotalCorCap = TotalCorCap + ws.Cells(i, "AQ")
            ws.Cells(42, "D") = TotalPrice
            ws.Cells(42, "I") = TotalSurCap
            ws.Cells(42, "K") = TotalCorCap
            ws.Cells(42, "R") = TotalSF
            ws.Cells(42, "E") = ws.Cells(42, "V")
            ws.Cells(42, "F") = ws.Cells(42, "U")
        End If
    Next 'i
End If

Não há End Sub , então suponho que esta sub-rotina continue. Então também por favor adicione

Set ws = Nothing

logo antes da declaração End Sub

    

Answer 2

Comece removendo todos os loops desnecessários. Substitua:

For j = 41 To 60
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "A") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "D") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "E") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "F") = ""

    ThisWorkbook.Worksheets("Breakdown").Cells(j, "H") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "I") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "J") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "K") = ""

    ThisWorkbook.Worksheets("Breakdown").Cells(j, "O") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "P") = ""
    ThisWorkbook.Worksheets("Breakdown").Cells(j, "Q") = ""
Next j

com:

With ThisWorkbook.Worksheets("Breakdown")
    .Range("A41:A60") = ""
    .Range("D41:F60") = ""
    .Range("H41:K60") = ""
    .Range("O41:Q60") = ""
End With