none
VBA - Loop Colunas RRS feed

  • Pergunta

  • Olá, 

    Recebi um código aqui do fórum mesmo de varredura, que executa a soma de diferentes abas em uma única, porém preciso que o código se repita, por exemplo das colunas A - Z, ou se for preciso adaptar o número de colunas, pois cada coluna representa um mês, gostaria de saber algum loop para o código se repetir pelas colunas, segue meu código atual:

                                                                                                                                                                       

    Option Explicit

    Sub VARREDURA()
        'CADA CL REPRESENTA UMA CÉLULA
        'DE UMA PLANILHA DIFERENTE

        Dim CL, PL As Object
        Dim LINHA, LINX, COLX As Long

        'A PARTIR DA LINHA 1
        LINHA = 1
        'PERCORRE A COLUNA1 DA PLANILHA4
        While ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 1) <> ""
            'LIMPA A COLUNA2
            ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 5).ClearContents
            'PERCORRE TODAS AS PLANILHAS DESTA PASTA DE TRABALHO
            For Each PL In ThisWorkbook.Sheets
                'EXCETO A PLANILHA4
                If PL.Name <> "Sheet1" Then
                    'PERCORRE AS CÉLULAS DA PL.NAME
                    'USEDRANGE VAI DE A1 ATÉ A ÚLTIMA CÉLULA UTILIZADA
                    For Each CL In ThisWorkbook.Sheets(PL.Name).UsedRange.Cells
                        'COMPARA OS VALORES DA PLANILHA4 COM A PL.NAME
                        If ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 1).Value = CL.Value Then


                            'GUARDA A LINHA E A COLUNA DA CÉLULA CORRESPONDENTE
                            LINX = CL.Row
                            COLX = CL.Column
                            'EFETUA A SOMA NA PLANILHA4
                            ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 5).Value = ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 5).Value + ThisWorkbook.Sheets(PL.Name).Cells(LINX, COLX + 4).Value


                        End If

                    Next CL
                End If
            Next PL
            LINHA = LINHA + 1
        Wend



        'EXIBE MENSAGEM
            MsgBox "SOMA EFETUADA!"

    End Sub

    terça-feira, 19 de dezembro de 2017 16:19

Todas as Respostas

  • Option Explicit
    
    Sub VARREDURA()
        'CADA CL REPRESENTA UMA CÉLULA
        'DE UMA PLANILHA DIFERENTE
        
        Dim CL, PL As Object
        Dim LINHA, LINX, COLX, COLUNA As Long
        
        'A PARTIR DA LINHA 1
        LINHA = 1
        'PERCORRE AS COLUNAS DE 1 A 26
        For COLUNA = 1 To 26
            'PERCORRE A COLUNA DA Sheet1
            While ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA) <> ""
                'LIMPA A COLUNA
                ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).ClearContents
                'PERCORRE TODAS AS PLANILHAS DESTA PASTA DE TRABALHO
                For Each PL In ThisWorkbook.Sheets
                    'EXCETO A Sheet1
                    If PL.Name <> "Sheet1" Then
                        'PERCORRE AS CÉLULAS DA PL.NAME
                        'USEDRANGE VAI DE A1 ATÉ A ÚLTIMA CÉLULA UTILIZADA
                        For Each CL In ThisWorkbook.Sheets(PL.Name).UsedRange.Cells
                            'COMPARA OS VALORES DA Sheet1 COM A PL.NAME
                            If ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value = CL.Value Then
                                
                                
                                'GUARDA A LINHA E A COLUNA DA CÉLULA CORRESPONDENTE
                                LINX = CL.Row
                                COLX = CL.Column
                                'EFETUA A SOMA NA Sheet1
                                ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value = ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value + ThisWorkbook.Sheets(PL.Name).Cells(LINX, COLX + 4).Value
                                
                                
                            End If
                            
                        Next CL
                    End If
                Next PL
                LINHA = LINHA + 1
            Wend
            
        Next COLUNA
        
        'EXIBE MENSAGEM
        MsgBox "SOMA EFETUADA!"
        
    End Sub
    


    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 20 de dezembro de 2017 10:38
    • Editado AndersonFDiniz2 quarta-feira, 20 de dezembro de 2017 10:46
    • Marcado como Resposta MoniMoni24 quarta-feira, 20 de dezembro de 2017 13:06
    • Não Marcado como Resposta MoniMoni24 quarta-feira, 20 de dezembro de 2017 13:06
    quarta-feira, 20 de dezembro de 2017 10:37
  • Olá Anderson,

    Então eu testei, mas no caso ele limpa as colunas com os códigos dos produtos, que seriam as 4 primeiras, eu queria que ela repetisse a mesma macro de soma, nas colunas seguintes, segue uma foto de como esta a planilha, quero que ela some quanto aconteceu em fevereiro e nos meses seguintes, e com que me passou, eu até tentei ajustar, mas não funcionou, vc acha que é possível colocar o loop, depois da soma?

    quarta-feira, 20 de dezembro de 2017 13:11
  • desculpa fazer duas respostas, eu fiz um ajuste, e quase deu certo, pq pelo menos já consegui somar na coluna seguinte, mas ele esta puxando a soma de janeiro, que é coluna E, quero que ele vá buscar a soma na coluna F:

    Option Explicit

    Sub VARREDURA()
        'CADA CL REPRESENTA UMA CÉLULA
        'DE UMA PLANILHA DIFERENTE

        Dim CL, PL As Object
        Dim LINHA, LINX, COLX, COLUNA As Long

        'A PARTIR DA LINHA 1
        LINHA = 2
        COLUNA = 5
        'PERCORRE A COLUNA1 DA PLANILHA1
        While ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 1) <> ""
            'LIMPA A COLUNA 5
            ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).ClearContents
            'PERCORRE TODAS AS PLANILHAS DESTA PASTA DE TRABALHO
            For Each PL In ThisWorkbook.Sheets
                'EXCETO A PLANILHA4
                If PL.Name <> "Sheet1" Then
                    'PERCORRE AS CÉLULAS DA PL.NAME
                    'USEDRANGE VAI DE A1 ATÉ A ÚLTIMA CÉLULA UTILIZADA
                    For Each CL In ThisWorkbook.Sheets(PL.Name).UsedRange.Cells
                        'COMPARA OS VALORES DA PLANILHA4 COM A PL.NAME
                        If ThisWorkbook.Sheets("Sheet1").Cells(LINHA, 1).Value = CL.Value Then


                            'GUARDA A LINHA E A COLUNA DA CÉLULA CORRESPONDENTE
                            LINX = CL.Row
                            COLX = CL.Column
                            'EFETUA A SOMA NA PLANILHA4
                            ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value = ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value + ThisWorkbook.Sheets(PL.Name).Cells(LINX, COLX + 4).Value


                        End If

                    Next CL
                End If
            Next PL
            LINHA = LINHA + 1
            COLUNA = COLUNA + 1
        Wend

        

        'EXIBE MENSAGEM
            MsgBox "SOMA EFETUADA!"

    End Sub

    quarta-feira, 20 de dezembro de 2017 13:38
  • Option Explicit
    
    Sub VARREDURA()
        'CADA CL REPRESENTA UMA CÉLULA
        'DE UMA PLANILHA DIFERENTE
        
        Dim CL, PL As Object
        Dim LINHA, LINX, COLX, COLUNA As Long
        
        'A PARTIR DA LINHA 1
        LINHA = 1
        'PERCORRE AS COLUNAS DE 5 A 17
        For COLUNA = 5 To 17
            'PERCORRE A COLUNA DA Sheet1
            While ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA) <> ""
                'LIMPA A COLUNA
                ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).ClearContents
                'PERCORRE TODAS AS PLANILHAS DESTA PASTA DE TRABALHO
                For Each PL In ThisWorkbook.Sheets
                    'EXCETO A Sheet1
                    If PL.Name <> "Sheet1" Then
                        'PERCORRE AS CÉLULAS DA PL.NAME
                        'USEDRANGE VAI DE A1 ATÉ A ÚLTIMA CÉLULA UTILIZADA
                        For Each CL In ThisWorkbook.Sheets(PL.Name).UsedRange.Cells
                            'COMPARA OS VALORES DA Sheet1 COM A PL.NAME
                            If ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value = CL.Value Then
                                
                                
                                'GUARDA A LINHA E A COLUNA DA CÉLULA CORRESPONDENTE
                                LINX = CL.Row
                                COLX = CL.Column
                                'EFETUA A SOMA NA Sheet1
                                ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value = ThisWorkbook.Sheets("Sheet1").Cells(LINHA, COLUNA).Value + ThisWorkbook.Sheets(PL.Name).Cells(LINX, COLX + 4).Value
                                
                                
                            End If
                            
                        Next CL
                    End If
                Next PL
                LINHA = LINHA + 1
            Wend
            
        Next COLUNA
        
        'EXIBE MENSAGEM
        MsgBox "SOMA EFETUADA!"
        
    End Sub


    A MELHOR FORMA DE AGRADECER E VOTAR COMO UTIL OU MARCAR COMO RESPOSTA Anderson Diniz diniabr2011@gmail.com


    • Sugerido como Resposta AndersonFDiniz2 quarta-feira, 20 de dezembro de 2017 20:09
    • Editado AndersonFDiniz2 quarta-feira, 20 de dezembro de 2017 20:11
    quarta-feira, 20 de dezembro de 2017 20:09