Este fórum está sendo desativado

[Leticia08]

Boa tarde!

Tenho esse código para ler e incrementar nas próximas linhas os valores do dicionário porém quando ele lê as próximas linhas retorna o valor 0. Alguém poderia me ajudar?

Sub teste_m²()

i = 6 'variável para pular linha
j = 17


Dim TheVars As Range, c As Range

Do While Cells(i, 7) <> "" 'variável para gravar o conteúdo da célula

Set TheVars = Worksheets("Mapeamento").Range("G" & i, "O" & i)

'Dictionary
Dim d
Set d = CreateObject("Scripting.Dictionary")

While j <= 22

d.Add Worksheets("Mapeamento").Cells(5, j).Value, Worksheets("Mapeamento").Cells(4, j).Value

j = j + 1

Wend

last = ""
current = ""
cont = 0

'laço importante
For Each c In TheVars
current = c.Value
If current <> last Then
'área correspondente do current + count
cont = cont + d(current)
End If

last = c.Value
Next c

Cells(i, 23) = cont

i = i + 1 'soma ela mesma, pula para próxima linha

Loop

End Sub

[osvaldomp]

Sugestão: independente do seu código atual, disponibilize diretamente aqui no fórum uma amostra do seu arquivo Excel com alguns dados, na própria planilha que contém os dados informe com exatidão qual é o seu objetivo, coloque o resultado desejado com as necessárias explicações.

[Leticia08]

Olá!

O arquivo está em anexo.

O que quero com essa planilha é retornar o valor da soma das áreas por meio da identificação na coluna W. Ele deve ler o número (identificação) e retornar a área correspondente daquela sequência de número, por exemplo a linha 6, ele lê que há uma sequência de 1 (10m²), sequência de 2 (20m²) e sequência de 1 (10m²) e retorna a soma desses valores, 40 m², por meio do dictionary.
Esse resultado é o correto e é o que pretendo extrair desse código, porém quando faço o incremento para ler nas outras linhas o valor retornado é zero, porém está errado, ele deveria somar as áreas correspondentes as identificações.

Poderia me ajudar? Qualquer dúvida estou a disposição no meu e-mail (leticiafp08@gmail.com)

[osvaldomp]

O problema ocorre porque o Loop que carrega o objeto Dictionary está no interior do Loop que analisa o intervalo G6:O11 e a variável "j" não é reiniciada pelo código.

Então, na primeira vez que o Dictionary é acionado, isso ocorre para i=6, ele é carregado, porém a variável "j" permanece com o valor 22, aí, a partir do segundo acionamento, o que ocorre a partir de i=7, o Dictionary é reiniciado limpo/vazio, no entanto o Loop de carregamento não é realizado pois j=22, por isso a partir da linha 7 (i=7) o resultado lançado na coluna W é zero.

Para contornar basta acrescentar um comando para reiniciar a variável para j=17, por exemplo conforme em vermelho abaixo.
Wend
j = 17
last = ""

Outra forma para contornar, preferível tecnicamente, é colocar o Loop que faz o carregamento do objeto Dictionary fora e antes do Loop que analisa o intervalo G6:O11, conforme abaixo, neste caso não é necessário reiniciar "j".

atual:
========================================================
Dim TheVars As Range, c As Range
Do While Cells(i, 7) <> "" 'variável para gravar o conteúdo da célula
...
'Dictionary
...
Wend
...
Loop
========================================================

sugerido:
========================================================
Dim TheVars As Range, c As Range
'Dictionary
...
Wend
Do While Cells(i, 7) <> "" 'variável para gravar o conteúdo da célula
...
Loop
========================================================

Abaixo segue um código baseado no seu.

Código: Selecionar todos

Sub teste_m²V2()
 Dim TheVars As Range, c As Range, d, i As Long, j As Long, last As Long
 Dim current As Long, cont As Long
  i = 6 'variável para incrementar a linha no intervalo G6:O11
  j = 17 'variável para incrementar a coluna no intervalo Q4:V5
  'Dictionary
  Set d = CreateObject("Scripting.Dictionary")
  While j <= 22
   d.Add Worksheets("Mapeamento").Cells(5, j).Value, Worksheets("Mapeamento").Cells(4, j).Value
   j = j + 1
  Wend
  Do While Cells(i, 7) <> ""
   Set TheVars = Worksheets("Mapeamento").Range("G" & i, "O" & i)
   'laço importante
   For Each c In TheVars
    current = c.Value 'atribui o valor da célula à variável current
    If current <> last Then 'verifica se o valor da célula é diferente da anterior
     'área correspondente do current + count
     cont = cont + d(current) ' se for diferente, então adiciona o valor correspondente de (d) à variável cont
    End If
    last = c.Value 'atribui o valor da célula à variável last
   Next c
   Cells(i, 23) = cont 'lança o valor de cont na coluna W
   i = i + 1 'incrementa a linha
   last = 0: cont = 0
  Loop
End Sub