Notifications
Clear all

Otimizar código VBA

2 Posts
1 Usuários
0 Reactions
1,256 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Olá caros, boa tarde!

Tenho uma rotina pronta para abrir arquivos pré-determinados em células, e executar um comando para atualizar todas as Tabelas Dinâmicas, salvar e fechar.

É simples, e a rotina está pronta, conforme código abaixo:

Private Sub AtualizarBD()

    Loc01 = Sheets("OP").Range("B16")
    Loc02 = Sheets("OP").Range("B17")
    Loc03 = Sheets("OP").Range("B18")
    Loc04 = Sheets("OP").Range("B19")
    Loc05 = Sheets("OP").Range("B20")
    Loc06 = Sheets("OP").Range("B21")
    Loc07 = Sheets("OP").Range("B22")
    Loc08 = Sheets("OP").Range("B23")
    Loc09 = Sheets("OP").Range("B24")
    Loc10 = Sheets("OP").Range("B25")

    Arq01 = Sheets("OP").Range("D16")
    Arq02 = Sheets("OP").Range("D17")
    Arq03 = Sheets("OP").Range("D18")
    Arq04 = Sheets("OP").Range("D19")
    Arq05 = Sheets("OP").Range("D20")
    Arq06 = Sheets("OP").Range("D21")
    Arq07 = Sheets("OP").Range("D22")
    Arq08 = Sheets("OP").Range("D23")
    Arq09 = Sheets("OP").Range("D24")
    Arq10 = Sheets("OP").Range("D25")

    decisao = MsgBox("Deseja ATUALIZAR todos os bancos de dados?", vbYesNo, "AVISO")
    If decisao = vbYes Then

    'Arquivo 01

If Loc01 = "" And Arq01 = "" Then GoTo Next02
       
    Workbooks.Open Filename:=Loc01 & Arq01
    ActiveWorkbook.RefreshAll
    Windows(Arq01).Close True

Next02:
    
    'Arquivo 02

If Loc02 = "" And Arq02 = "" Then GoTo Next03

    Workbooks.Open Filename:=Loc02 & Arq02
    ActiveWorkbook.RefreshAll
    Windows(Arq02).Close True

Next03:
    
    'Arquivo 03

If Loc03 = "" And Arq03 = "" Then GoTo Next04
    
    Workbooks.Open Filename:=Loc03 & Arq03
    ActiveWorkbook.RefreshAll
    Windows(Arq03).Close True

Next04:
    
    'Arquivo 04

If Loc04 = "" And Arq04 = "" Then GoTo Next05

    Workbooks.Open Filename:=Loc04 & Arq04
    ActiveWorkbook.RefreshAll
    Windows(Arq04).Close True

Next05:
    
    'Arquivo 05

If Loc05 = "" And Arq05 = "" Then GoTo Next06

    Workbooks.Open Filename:=Loc05 & Arq05
    ActiveWorkbook.RefreshAll
    Windows(Arq05).Close True

Next06:
    
    'Arquivo 06

If Loc06 = "" And Arq06 = "" Then GoTo Next07

    Workbooks.Open Filename:=Loc06 & Arq06
    ActiveWorkbook.RefreshAll
    Windows(Arq06).Close True

Next07:
    
    'Arquivo 07

If Loc07 = "" And Arq07 = "" Then GoTo Next08

    Workbooks.Open Filename:=Loc07 & Arq07
    ActiveWorkbook.RefreshAll
    Windows(Arq07).Close True

Next08:
    
    'Arquivo 08

If Loc08 = "" And Arq08 = "" Then GoTo Next09

    Workbooks.Open Filename:=Loc08 & Arq08
    ActiveWorkbook.RefreshAll
    Windows(Arq08).Close True

Next09:

    'Arquivo 09

If Loc09 = "" And Arq09 = "" Then GoTo Next10

    Workbooks.Open Filename:=Loc09 & Arq09
    ActiveWorkbook.RefreshAll
    Windows(Arq09).Close True

Next10:
    
    'Arquivo 10

If Loc10 = "" And Arq10 = "" Then GoTo FINAL

    Workbooks.Open Filename:=Loc10 & Arq10
    ActiveWorkbook.RefreshAll
    Windows(Arq10).Close True

FINAL:

MsgBox "TODAS AS BASES DE DADOS FORAM ATUALIZADAS COM SUCESSO!"

' Atualizar data e hora

Sheets("CAPA").Select
ActiveSheet.Unprotect

    Range("J20").Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "=TEXT(NOW(),""dd"")&"" / ""&PROPER(TEXT(NOW(),""mmm""))&"" / ""&TEXT(NOW(),""aaaa"")&"" | ""&TEXT(NOW(),""hh:mm;@"")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

    End If

End Sub

O problema é: Esse código está muito grande, e não tenho expertise para otimizá-lo. Eu sei que tem como o VBA verificar linha por linhas, até achar uma vazia, e parar... MAs não sei como fazer.

Alguém pode me ajudar nessa tarefa?

 
Postado : 19/10/2011 12:38 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Segue uma possibilidade

Private Sub atualizaBD()
Dim Loc As String, Arq As String
Dim i As Long
For i = 16 To 25
Loc = Sheets("OP").Range("B" & i)
Arq = Sheets("OP").Range("D" & i)
    If Loc <> "" And Arq <> "" Then
            Workbooks.Open Filename:=Loc & Arq
            ActiveWorkbook.RefreshAll
            Windows(Arq).Close True
    End If
Next
Sheets("CAPA").Activate
ActiveSheet.Unprotect

    Sheets("CAPA").Range("J20") = Format(Date, "dd") & " / " & UCase(Format(Date, "mmm")) & " / " & Format(Date, "yyyy") & " | " & Format(Time, "hh:mm;@")

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

MsgBox "TODAS AS BASES DE DADOS FORAM ATUALIZADAS COM SUCESSO!"

End Sub
 
Postado : 22/10/2011 12:51 pm