Excel VBA Planilha datas relatório base ano mês

Planilha Excel VBA datas relatorio base ano mes

Planilha Excel VBA datas relatório base ano mês

Este Macro e procedimento do Aplicativo Microsoft Excel VBA(Visual Basic Application), faz uma comparação, de datas (ano e mes) e extrai determinados dados. observe que usei o Evento WorkhseetChange() ao escrever(digitar) na célula(c2), ao alterar a data com auxlio da lista suspensa (Validação de dados), chamará o macro que verifica os critérios e extrai os dados relativos.

Option Explicit
‘//======’escola saberexcel vba estudos®
Sub sbx_extrair_itens_base_mes()
Dim vMes As String
Dim vAno As Integer
Dim tbAREA As Variant
Dim vItem As Integer
Dim vCol As Byte
Dim vMesCompare As String
Dim vAnoCompare As Integer
Dim vLinhaRELATORIO As Integer
Application.ScreenUpdating = False

With Saber1 ‘ usar o nome de código ou da folha de planilha aba
‘Worksheets(“Principal”) Referenciando a folha de planilha
vMes = Format(.Range(“C2”), “mmmm”) ‘formato para a varviável vMes
vAno = .Range(“D2”)

tbAREA = .Range(“A3:B” & .Range(“A65536”).End(xlUp).Row) ‘para verifica o conteudo da tabela
.Range(“C3:D” & .Range(“A65536”).End(xlUp).Row).ClearContents ‘limpar a area de dados para nova busca
For vItem = 1 To UBound(tbAREA, 1) ‘para cada linha da tabela
vMesCompare = Format(tbAREA(vItem, 1), “mmmm”) ‘recupera os valores comparando “vMesCompare” e “vAnoCompare”
vAnoCompare = Year(CDate(tbAREA(vItem, 1)))
If vMesCompare = vMes And vAnoCompare = vAno Then ‘condição if se for igual faça:
vLinhaRELATORIO = .Range(“C65536”).End(xlUp).Row + 1 ‘detectar a última linha vazia na coluna C
For vCol = 1 To UBound(tbAREA, 2) ‘para cada coluna da tabela Area determinada
If vCol = 1 Then ‘se a coluna é igual a 1 em formatos
.Cells(vLinhaRELATORIO, vCol + 2).NumberFormat = “dd/mm/yyyy”
.Cells(vLinhaRELATORIO, vCol + 2) = tbAREA(vItem, vCol)
Else
.Cells(vLinhaRELATORIO, vCol + 2) = tbAREA(vItem, vCol) ‘senão cola a linha inalterada
End If
Next vCol
End If
Next vItem
End With
Application.ScreenUpdating = True
End Sub
‘//===========’ sensibilizando o evento WorkSheetChange() ao alterar célula (C2), chama o macro acima

‘escola saberexcel vba estudos®
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range(“C2”)) Is Nothing Then
sbx_extrair_itens_base_mes ‘chama o macro
End If
End Sub