Notifications

Clear all

Melhorias no Codigo

2024 - VBA & Macros

Post Recente por ranjp 12 anos atrás

7 Posts

2 Usuários

0 Reactions

2,225 Visualizações

RSS

ranjp

(@ranjp)

Posts: 37

Eminent Member

Topic starter

Ola, pessoal, estou tetando aprender um pouco de macro/vba.

Montei o codigo que esta na planilha em anexo usando exemplos daqui do forum e tetando adaptar ao que preciso fazer.
Gostaria de uma ajuda para melhorar os codigos para facilitar manutencoes futuras ( aumento de planilhas ) e uma ajuda para executar um procedimento que nao estou conseguindo executar.

Bom, o que o codigo faz: verifica arquivos numa determinada pasta, abre 1 arquivo por vez, copia os dados de cada planilha num arquivo "receptor" que possui as mesmas planilhas. Coloca os dados de cada planilha no arquivo receptor em ordem crescente e no final da transferencia de todos os arquivos ele deleta da pasta os arquivos de dados.

O procedimento que nao estou conseguindo fazer: apos copiar os dados para a planilha receptor, precisava que colocasse o nome da planilha em uma coluna que nao esta sendo usada ( como se fosse dados ). Deixei esse codigo em forma de comentario na parte A-1.

Os arquivos de dados possuem colunas de A a L e 22 planilhas. O nome da planilha ira ficar na coluna K. A 1a linha eh o cabecalho da tabela.

Meu excel eh em japones e por isso algumas palavras ( nome do arquivo e pasta ) devera aparecer em forma de desenho xD.
Fonte do codigo que estou usando aqui:
viewtopic.php?f=10&t=2920 ( verificar arquivos e fazer a copia dos dados )
viewtopic.php?f=10&t=2675&p=11807&hilit=deletar+arquivos#p11807 ( deletar arquivos da pasta )

Agradeco a paciencia e ajuda de todos.

Postado : 17/07/2012 12:51 am

ranjp

(@ranjp)

Posts: 37

Eminent Member

Topic starter

Fiz algumas alteracoes no codigo do meu arquivo. Descobri que em cada planilha a ultima linha de dados estava sendo substituida pelos dados do proximo arquivo importado. Abaixo esta a parte que alterei:

If Range("A1048576").End(xlUp).Value = "" Then
        Range("A1048576").End(xlUp).Select
        Else: Range("A1048576").End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        End If
        ActiveSheet.Paste

Tambem consegui fazer a macro pra colocar o nome da planilha de acordo com a quantidade de dados de cada planilha usando o "monstrinho" abaixo. Sera que poderiam me dar umas dicas de como melhorar isso?:

Sub LinhaA1()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-1").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA2()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-2").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA3()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-3").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA4()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-4").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA5()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-5").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA6()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-6").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA7()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-7").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA8()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-8").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaA9()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-9").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaAA()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("A-A").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB1()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-1").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB2()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-2").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB3()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-3").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB4()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-4").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB5()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-5").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB6()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-6").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB7()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-7").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB8()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-8").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaB9()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-9").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaBA()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-A").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaBB()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-B").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub LinhaBC()
    
    Dim XI As Long
    
    Application.Workbooks("★取込まとめ").Worksheets("B-C").Activate
    For XI = 2 To 1048576 Step 1
        If ActiveSheet.Cells(XI, 7).Value = "" Then
           ActiveSheet.Cells(XI, 1).Select
           Exit Sub
        Else: ActiveSheet.Cells(XI, 13).Value = ActiveSheet.Name
        End If
    Next XI
End Sub
Sub Chama()

Call LinhaA1
     LinhaA2
     LinhaA3
     LinhaA4
     LinhaA5
     LinhaA6
     LinhaA7
     LinhaA8
     LinhaA9
     LinhaAA
     LinhaB1
     LinhaB2
     LinhaB3
     LinhaB4
     LinhaB5
     LinhaB6
     LinhaB7
     LinhaB8
     LinhaB9
     LinhaBA
     LinhaBB
     LinhaBC
     
     
End Sub

Estou incluindo outro arquivo chamado "arquivodados". Esse arquivo seria aquele que eu vou receber todos os dias e de onde eu devo importar os dados. A tabela comeca a partir da linha 9 e por isso no momento estou tendo que apagar as 8 primeira linhas de cada planilha antes de comecar a importacao. Gostaria de pedir uma dica nessa parte para incluir esse procedimento no codigo. Pensei em definir a area a ser copiada pegando a area da linha9 ate a ultima linha usada, porem nao estou conseguindo definir a ultima linha usada. No momento a area a ser copiada esta definida atras do codigo abaixo:

ActiveSheet.UsedRange.Select
            Selection.Copy

Agradeco e espero ancioso por qualquer dica e ajuda. Vlw.

Postado : 19/07/2012 5:49 pm

ranjp

(@ranjp)

Posts: 37

Eminent Member

Topic starter

Estou incluindo outro arquivo chamado "arquivodados". Esse arquivo seria aquele que eu vou receber todos os dias e de onde eu devo importar os dados. A tabela comeca a partir da linha 9 e por isso no momento estou tendo que apagar as 8 primeira linhas de cada planilha antes de comecar a importacao. Gostaria de pedir uma dica nessa parte para incluir esse procedimento no codigo. Pensei em definir a area a ser copiada pegando a area da linha9 ate a ultima linha usada, porem nao estou conseguindo definir a ultima linha usada. No momento a area a ser copiada esta definida atraves do codigo abaixo:
ActiveSheet.UsedRange.Select
            Selection.Copy
Agradeco e espero ancioso por qualquer dica e ajuda. Vlw.

Alguem poderia me ajudar com essa parte?

Postado : 25/07/2012 5:54 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Veja se lhe auxilia:

    
'Determina qual a ultima coluna com valores
        Sheet.Activate
        nC = Mid(Cells(1, Cells.Columns.Count).End(xlToLeft).Address, 2, _
             InStr(2, Cells(1, Cells.Columns.Count).End(xlToLeft).Address, "$", 1) - 2)
    'Seleciona as colunas
        Columns("A:" & nC).Select
    'Seleciona somente range com valores
        Range(Selection, Selection.End(xlDown)).Select
    'Determina qual a ultima linha com valores
        Lin = Selection(Cells.Rows.Count).End(xlUp).row
    'Copia range com dados
        Range("A9:" & nC & Lin).Copy

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 26/07/2012 9:54 am

ranjp

(@ranjp)

Posts: 37

Eminent Member

Topic starter

Opa Reinaldo,

Obrigado por ter respondido.
Deu erro de execucao: 424 Necessario o objeto ( traducao livre pois meu excel eh em japones ). Aih onde esta Sheet.Activate fica marcado em amarelo.

Apesar de ter dado erro me foi muito util o codigo que vc passou. Me deu uma " possibilidade a mais de raciocinio". Bom, o que eu fiz foi:

Range("A1").Select
        Lin = Selection(Cells.Rows.Count).End(xlUp).Row
        Range("A10:M" & Lin).Copy

-Retirei o Sheet.Activate ja que antes dele tinha Application.Workbooks(sName).Worksheets("A-1").Activate
-Coloquei pra selecionar o A1 porque nao sei explicar mas em algumas planilhas que outra celula estivesse selecionada dava erro em Lin = Selection(Cells.Rows.Count).End(xlUp).Row
-Retirei a parte do nC ate o Lin porque nao sei por qual motivo, em algumas planilhas ele soh tava copiando a coluna A
-Utilizei o Lin pra achar a ultima linha ( esse codigo foi a peca chave pra mim )
-Fixei o range que eu quero copiar conforme o codigo acima, ja que o ponto inicial ( A10 ) e a quantidade de colunas nao mudam ( ate M ). Faltava apenas descobrir a ultima linha.

Muito obrigado pela ajuda. Ja estava desistindo pois ninguem dava um retorno ( talvez porque eu escrevo demais xD ) e de certa forma o codigo tava funcionando. Mas agora ficou melhor porque nao preciso ficar deletando as 9 1as linhas das planilhas. Sem contar que esta copiando somente o necessario, sem linhas e colunas extras que aparentemente estao em branco mas que entravam no UsedRange.

PS: se nao for pedir muito, poderia explicar ou indicar algo pra eu entender o que essa parte faz? Como vc comentou, ela determina a ultima coluna com valores, mas estava pegando somente a coluna A das planilhas B-1 ate B-C. Nas planilhas A-1 ate A-A funcionou direitinho.

nC = Mid(Cells(1, Cells.Columns.Count).End(xlToLeft).Address, 2, _
             InStr(2, Cells(1, Cells.Columns.Count).End(xlToLeft).Address, "$", 1) - 2)

Vou colocar como resolvido, mas se alguem quiser me ajudar mais um poquinho, nao vou achar ruim

Postado : 26/07/2012 8:44 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Olá, realmente a linha sheet.activate; so funcionaria em um loop :mrgreen: (copiei ráridamente de um outro codigo que estava trabalhando e esqueci de atualizar).
Bom que conseguiu utilizar/adaptar para sua necessidade, eu creio que assim o aprendizado/entendimento fica muito mais marcante.
Qto à sua pergunta sobre a linha:

nC = Mid(Cells(1, Cells.Columns.Count).End(xlToLeft).Address, 2, InStr(2, Cells(1, Cells.Columns.Count).End(xlToLeft).Address, "$", 1) - 2)

a expressão: cells(Cells(1, Cells.Columns.Count).End(xlToLeft)
tem por objetivo se "deslocar até a ultima coluna utilizada; porem da linha (no caso 1 refere-se a linha 1), como não atentei a estrutura de sua planilha não alterei, deveria alterar para o numero da linha que contem o cabecalho, ou como vc mesmo disse para linha 10 que é a que interessava.
Com a expressao address, o retorno nessa parte do codigo é o endereço da coluna; exemplol supondo que a ultima coluna fosse m então teria: $M$1;
Já inStr... conforme o help do excel:"Retorna uma Variant (Long) que especifica a posição da primeira ocorrência de uma seqüência de caracteres dentro de outra.";
Isso para no final retornar somente a letra da coluna; nC=M ou nc=AB.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 27/07/2012 7:57 am