DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT - Moving Annual Total

DONUT PROJECT - VBA - Criando uma Matriz de Datas MAT

​

Em diversas ocasiões usamos tabelas com períodos MAT, geralmente estas são extraídas de BIs (Business Information). Os cabeçalhos nem sempre são aquilo que desejaríamos usar.

​

Como podemos conciliar o conteúdo, adequando os títulos?

As funções abaixo lhe permitirão carregar (LoadMonths()) em uma Matriz, 12 meses, sendo o primeiro uma data passada e os próximos 11 meses serão calculados retroativamente. Depois poderão recuperar (ReturnMonth()) estas datas.

Global nMeses(12) As Date

Sub LoadMonths()

    '      Author: André Bernardes

    '        Date: 20/08/14 - 09:53

    '      Action: Cria tabelas de Regionais para análise.

    ' Application: Analysis****Regional®

    '   Test line: nMeses (1), nMeses(2), nMeses(3), nMeses(4), nMeses(5), nMeses(6), nMeses(7), nMeses(8), nMeses(9), nMeses(10), nMeses(11), nMeses(12)

    '   Test line: Debug.Print ReturnMonth(1), ReturnMonth(2), ReturnMonth(3), ReturnMonth(4), ReturnMonth(5), ReturnMonth(6), ReturnMonth(7), ReturnMonth(8), ReturnMonth(9), ReturnMonth(10), ReturnMonth(11), ReturnMonth(12)

    Dim i As Integer

    Dim Flag As Boolean

    Dim LastDate As Date

    Let Flag = True

    For i = 1 To 12

        If Flag Then

            Let nMeses(i) = Sheets("Analise").Range("I5").Value

            Let LastDate = nMeses(i)

            Let Flag = False

        Else

            Let nMeses(i) = DateAdd("m", -1, LastDate)

            Let LastDate = nMeses(i)

        End If

    Next

End Sub

Function ReturnMonth (nMnth As Integer) As String

    '      Author: André Bernardes

    '        Date: 20/08/14 - 09:53

    '      Action: Cria tabelas de Regionais para análise.

    ' Application: AnalysisMDTRRegional®

    '   Test line: nMeses (1), nMeses(2), nMeses(3), nMeses(4), nMeses(5), nMeses(6), nMeses(7), nMeses(8), nMeses(9), nMeses(10), nMeses(11), nMeses(12)

    '   Test line: Debug.Print ReturnMonth(1), ReturnMonth(2), ReturnMonth(3), ReturnMonth(4), ReturnMonth(5), ReturnMonth(6), ReturnMonth(7), ReturnMonth(8), ReturnMonth(9), ReturnMonth(10), ReturnMonth(11), ReturnMonth(12)

    Dim nMonth As String

    Dim nYear As String

    Dim nTitle01 As String

    Let nMonth = Mid(Format(nMeses(nMnth), "DD/MM/YYYY"), 4, 2)

    Let nYear = Year(nMeses(nMnth))

    Let nTitle01 = UCase(Left(Format(Month(nMonth), "mmm"), 3))

    If nMonth = "01" Then

        Let ReturnMonth = "JAN|" & nYear

    ElseIf nMonth = "02" Then

        Let ReturnMonth = "FEV|" & nYear

    ElseIf nMonth = "03" Then

        Let ReturnMonth = "MAR|" & nYear

    ElseIf nMonth = "04" Then

        Let ReturnMonth = "ABR|" & nYear

    ElseIf nMonth = "05" Then

        Let ReturnMonth = "MAI|" & nYear

    ElseIf nMonth = "06" Then

        Let ReturnMonth = "JUN|" & nYear

    ElseIf nMonth = "07" Then

        Let ReturnMonth = "JUL|" & nYear

    ElseIf nMonth = "08" Then

        Let ReturnMonth = "AGO|" & nYear

    ElseIf nMonth = "09" Then

        Let ReturnMonth = "SET|" & nYear

    ElseIf nMonth = "10" Then

        Let ReturnMonth = "OUT|" & nYear

    ElseIf nMonth = "11" Then

        Let ReturnMonth = "NOV|" & nYear

    ElseIf nMonth = "12" Then

        Let ReturnMonth = "DEZ|" & nYear

    End If

End Function

Caso queiram traduzir os meses para outros idiomas basta que alterem os meses.

André Luiz Bernardes

Professional Profile

DONUT PROJECT - VBA - Excel - Atualizando Tabelas Dinâmicas - Refresh Pivot Table via VBA

DONUT PROJECT - VBA - Excel - Atualizando Tabelas Dinâmicas - Refresh Pivot Table via VBA

​

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Baixe o Calendário Compacto para 2014 em Excel

Aqueles que utilizam as Tabelas Dinâmicas em alta escala têm consciência do poder que elas têm e da praticidade que trazem para os nossos projetos.

Nos códigos abaixo olharemos para algumas situações onde poderemos atualizar todas as Pivots, ou apenas Pivots escolhidas.

Atualizando uma tabela Simples

Private Sub Worksheet_Activate()

Run "PivotMacro"

End Sub

Sub PivotMacro()

Dim pt As PivotTable

Set pt = ActiveSheet.PivotTables("MyPivot")

pt.RefreshTable

End Sub

Atualizando todas asTabelas Dinâmicas da Planilha

Sub AllWorksheetPivots()

    Dim pt As PivotTable

    For Each pt In ActiveSheet.PivotTables

        pt.RefreshTable

    Next pt 

End Sub

Atualizando uma Tabelas Dinâmicas específicas

Sub ChosenPivots()

Dim pt As PivotTable

    For Each pt In ActiveSheet.PivotTables    

        Select Case pt.Name

            Case "PivotTable1", "PivotTable4", "PivotTable8"

                pt.RefreshTable

            Case Else

        End Select

    Next pt

End Sub

Atualize todas as Tabelas Dinâmicas Selecionadas

Sub AllWorkbookPivots()

Dim pt As PivotTable

Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets    

        For Each pt In ws.PivotTables

                    pt.RefreshTable

        Next pt

    Next ws

    

End Sub

André Luiz Bernardes

Professional Profile

DONUT PROJECT - VBA - Access - Criando uma Query com Parâmetros

DONUT PROJECT - VBA - Access - Criando uma Query com Parâmetros

​

​

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Baixe o Calendário Compacto para 2014 em Excel

Essa técnica pode ajudá-lo em projetos nos quais precise de certa agilidade para criar bases de dados para análises.

O código abaixo o ajudará a fazer isso.

Sub CrieQueriesComParametros()

    '      Author: André Bernardes

    '        Date: 18/08/14 - 10:38

    '      Action: Cria uma query com Parâmetros.

    ' Application: ****®

    Dim dbs As DAO.Database

    Dim qdf As DAO.QueryDef

    Dim strSQL As String

    Set dbs = CurrentDb

    Set qdf = dbs.CreateQueryDef("nQuery")

    Application.RefreshDatabaseWindow

    Let strSQL = "PARAMETERS Param1 TEXT, Param2 INT; "

    Let strSQL = strSQL & "SELECT * FROM [Table1] "

    Let strSQL = strSQL & "WHERE [Field1] = [Param1] AND [Field2] = [Param2];"

    Let qdf.SQL = strSQL

    qdf.Close

    Set qdf = Nothing

    Set dbs = Nothing

End Sub

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

DONUT PROJECT - VBA - Access - Atualizando o conteúdo de uma Query

​

Consultancy in Excel, Access, VBA, Dashboards, Scorecards & PowerPoint Projects

DESENVOLVO APLICAÇÕES VBA

Perguntas, Questões e Esclarecimentos

Baixe o Calendário Compacto para 2014 em Excel

É muito mais rápido atualizarmos internamente o conteúdo de uma query do que ficar criando-a todas as vezes que precisarmos. A performance conseguida em grandes volumetrias é incrível.

O código abaixo o ajudará a fazer isso.

Sub UpdateQuery(QueryName, SQL)

    '      Author: André Bernardes

    '        Date: 18/08/14 - 09:53

    '      Action: Atualiza o conteúdo de uma query com um novo script.

    ' Application: ****®

    ' Usando o nome da query e o respectivo script, caso a query não exista.

    If IsNull(DLookup("Name", "MsysObjects", "Name='" & QueryName & "'")) Then

        ' Cria-a, ...

        CurrentDb.CreateQueryDef QueryName, SQL

    Else

        ' Caso contrário, atualizao o script sql.

        Let CurrentDb.QueryDefs(QueryName).SQL = SQL

    End If

End Sub

Para evocar o código basta fazer assim:

' Atualiza a query que é a base de todas as análises.

Dim nSQL2 As String

Let nSQL2 = "SELECT * " & _

                     "FROM lnk_Med " & _

                     "WHERE (((Left([FVD_Sector],2))='" & nParticula & "')) "

Call UpdateQuery("qry_lnk", nSQL2)

Lembre-se que deletar uma query inexistente pode causar um erro:

DoCmd.DeleteObject acQuery, "qry_lnk"

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart |