Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

Views

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

Inline image 1

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

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





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

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





É 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"

Inline image 1

LinkWithinBrazilVBAAccessSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine