Inquiridor
VBA - Loop Colunas

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
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
-
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?
-
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 -
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