

Nós veremos aqui a utilização das chaves do objeto « Dictionary » em uma variável de duas dimensões.
Isto tem um ar « bárbaro », mas na verdade, permite criar facilmente e rapidamente uma folha de recapitulação de uma planilha completa.
Uma planilha de vendas, por mês, vendedores e produtos vendidos.
Na planilha, 12 folhas, uma por mês.
Em cada uma dessas folhas, três colunas são completadas :
- Coluna A : os nomes dos vendedores,
- Coluna B : os nomes dos produtos vendidos,
- Coluna C :a quantidade.
Para integrar na sua planilha copie o código todo abaixo, ALT+F11, Inserção/Módulos, e colar o código. Para utilizar, fechar a janela Visual Basic Editor para voltar à sua planilha, depois: ALT+F8, escolher "RecapComSomaDasColunasC" depois clique em "Executar".
À adaptar :
- o nome da folha de recapitulação ("Recap" no exemplo)
- as Colunas "fontes " dos dados, A, B et C no exemplo
Opção Explicit
Sub RecapComSomaDesColunaC()
Dim Folha As Worksheet, i As Long
Dim TablVendedores(), DicoVendedores As Object
Dim TablVendas(), DicoVendas As Object
Dim Somas()
Set DicoVendedores = CreateObject("Scripting.Dictionary")
Set DicoVendas = CreateObject("Scripting.Dictionary")
'*******PREENCHIMENTO DOS OBJETOS DITIONARY E VARIÁVEIS*******
'preenchimento das etiquetas de linhas e de colunas sem duplicatas
For Each Folha In ThisWorkbook.Worksheets
If Folha.Name <> "Récap" Then
With Folha
TablVendedores = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
For i = LBound(TablVendedores, 1) To UBound(TablVendedores, 1)
If Not DicoVendedores.exists(TablVendedores(i, 1)) Then DicoVendedores.Add TablVendedores(i, 1), TablVendedores(i, 1)
Next i
TablVendas = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
For i = LBound(TablVendas, 1) To UBound(TablVendas, 1)
If Not DicoVendas.exists(TablVendas(i, 1)) Then DicoVendas.Add TablVendas(i, 1), TablVendas(i, 1)
Next i
End With
End If
Next Folha
'preenchimento da variável 2D graças as chaves do Dictionary
ReDim Somas(1 To DicoVendedores.Count, 1 To DicoVendas.Count)
For Each Folha In ThisWorkbook.Worksheets
If Folha.Name <> "Recap" Then
With Folha
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
Somas(Application.Match(.Cells(i, 1), DicoVendedores.keys, 0), Application.Match(.Cells(i, 2), DicoVendas.keys, 0)) = Somas(Application.Match(.Cells(i, 1), DicoVendedores.keys, 0), Application.Match(.Cells(i, 2), DicoVendas.keys, 0)) + .Range("C" & i).Value
Next i
End With
End If
Next Folha
'*******RESTITUTIÇÃO DOS DADOS *******
With Sheets("Recap")
.Range("A2").Resize(DicoVendedores.Count, 1) = Application.Transpose(DicoVendedores.keys)
.Range("B1").Resize(1, DicoVendas.Count) = DicoVendas.keys
.Range("B2").Resize(UBound(Somas, 1), UBound(Somas, 2)) = Somas()
End With
End Sub
Você pode baixar a planilha fonte exemplo
Tradução feita por Ana Spadari