FOR EACH ANINHADO P...
 
Notifications
Clear all

[Resolvido] FOR EACH ANINHADO P/ PERCORRER "CAMPOS" EM "REGISTRO" DE ARRAY P/ DICIONARY

7 Posts
2 Usuários
2 Likes
1,651 Visualizações
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

Salve galera do Planilhando!

Estou com a seguinte situação há alguns dias e não vejo a luz no fim do túnel (rsrs 😆 )

Seguinte: no código abaixo tenho um intervalo na planilha que ponho pra dentro de um Array; isso é feito a cada iteração de um Loop For Each, porém essa primeira iteração ocorre de forma vertical (imaginando como se estivesse na planilha), então ele itera a cada registro. A cada registro iterado eu preciso que seja feito um Loop interno, de forma horizontal, para pegar os próximos 8 campos de cada registro e ir povoando o um dicionário. O problema que ocorre, é quando, a partir, da segunda rodada de iteração, o 2º Loop continua puxando os dados anteriores na variável Campo, então é nesse ponto que não consigo progredir no código.

 

Agradeço as  sugestões de cada um que puder ajudar 🤗 

 

Dim lngUltCell         As Long
Dim arrRegistro       As Variant
Dim bln                   As Boolean
Dim Campo             As Variant
Dim Registro           As Variant
Dim cont                 As Long
Dim CodProd          As String
Dim rng                  As Range
Dim DictSht            As New Scripting.Dictionary


With Worksheets(1)
    'ÚLTIMA LINHA DA NA PLANILHA
    lngUltCell = .Cells(.Rows.Count, 1).End(xlUp).Row
    'INTERVALO COM DADOS P/ ARRAY
    Set rng = .Range(.Cells(2, 2), .Cells(lngUltCell, 9))
    'ARMAZENAMENTO NO ARRAY
    arrRegistro = rng
        'O REGISTRO É COMPOSTO DE 8 CAMPOS
        'NO INTERVALO ESTARAM LADO A LADO
        'O LOOP ABAIXO PERCORRE DE FORMA VERTICAL OS REGISTROS ATÉ A PRÓXMA 
        'COLUNA DE ATRIBUTOS
        For Each Registro In arrRegistro
                'Campo = Registro → AQUI TENTO FORÇAR Campo A ITERAR A PARTIR DO 
                'PRÓXIMO REGISTRO MAIS ELE PERSISTE NO REGISTRO ANTERIOR, SEMPRE!
                'A CADA LOOP VERTICAL PRECISO QUE TAMBÉM SEJA FEITO 8 LOOPS VERTICAIS 
                'PARA POVOAR MEU Dictionary, PORÉM Ñ FUNCIONA POIS ESTOU FAZENDO A 
                'VARIÁVEL "Campo" RECEBE SEMPRE O MESMO VALOR.
                For Each Campo In Application.Transpose(arrRegistro)
                    
                    Select Case cont
                        Case 1
                          CodProd = Campo
                          DictSht.Item(CodProd) = Array(0, 0, 0, 0, 0, 0, 0, 0)
                        Case 2 To 8
                            DictSht(CodProd)(cont) = Campo
                        Case 9
                            cont = 1
                            CodProd = ""
                 '           Campo = ""
                            If bln Then Call FFrm_ProdVazio(CodProd)
                            bln = False
                            Exit For
                    End Select
    
                        If IsEmpty(Campo) Or Campo = "" Then bln = True
                        cont = cont + 1
                Next Campo
        Next Registro

End With
 
Postado : 13/11/2021 2:51 pm
Raygsson
(@raygsson)
Posts: 68
Trusted Member
 

@amorim123

Monte um exemplo/planilha no padrão que vc possui as informações e um rascunho de como  seria essa saida de dados. Vai facilitar a análise.

 
Postado : 13/11/2021 10:26 pm
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

@raygsson 

Segue exemplo: A planilha "TaxApply - V 1.2 - Planilhando" contém  código a ser executado e a planilha "01948037000109-test" os dados a serem importados pela planilha anterior.

https://1drv.ms/u/s!Aj-bsGYbi-JE1xIyujimtPdlF05R?e=oxGVn6

 
Postado : 13/11/2021 11:33 pm
Raygsson
(@raygsson)
Posts: 68
Trusted Member
 

@amorim123 

Vi suas planilhas, a do código não precisava.

Na outra tem a sua base de dados, uma tabela com 9 colunas e diversas linhas.

Ainda não entendi o que você precisa fazer com esse dicionário, a finalidade.

Faltou aquele exemplo da saida/resultado esperado.

 
Postado : 14/11/2021 1:12 am
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

@raygsson Okay meu brother, me resume apenas ao problema, mas realmente é necessário contextualizar para entender o objetivo final, seguinte:

 

No intervalo da planilha que é importada "01948037000109-test" não posso ter campos vazios, então p/ validar isso pensei em um Array que descesse verticalmente e na sequência horizontalmente, pelos próximos 7 campos a partir da segunda coluna que corresponde aos códigos de produtos com os quais trabalho e para os quais não haverá valores iguais; independente de haver campos vazios ou não eu preciso que seja indexado em um dicionário cada registro (chave + 7 campos seguintes), porém os registros que contiverem campos vazios serão apresentados em ListBox para que com DubleClick o usuário possa avaliar novamente os dados e inserir as informações (se não preenchidas processo abortado, pois não pode haver dados vazios); aqui é onde entra a necessidade do Dictionary, pois somente com chaves indexadas poderei sobrescrever os dados sem escrever na planilha.

 

Sobre o exemplo de saída hahah.. ainda não sei como irei fazer, pois envolve obter diretamente os campos do dicionário, acredito que seja o processo reverso da inserção e reinserção pois o listbox vai retornar pro dicionário, com a resolução desse primeiro problema conseguirei entender (acredito), como funciona de fato as operações possíveis do dicionário. 

 
Postado : 14/11/2021 10:32 am
Raygsson
(@raygsson)
Posts: 68
Trusted Member
 

@amorim123 

Agora entendi rs

Fiz um exemplo que preenche o dicionário da forma que precisa, uma chave que será o código do produto e demais chaves para acessar os atributos.

Desta forma:

dict("000802")("DESCR_ITEM")
dict("000802")("TIPO_ITEM")
dict("000802")("CFOP")
etc....

 E aqui esta o script:

Sub exemplo()

Dim base As Variant
Dim dict As New Scripting.Dictionary
Dim lin As Long, col As Integer

base = Planilha1.Range("B1:I" & Planilha1.Range("B1").End(xlDown).Row)

For lin = 2 To UBound(base)

      For col = 2 To 8
            Dim dict_temp As New Scripting.Dictionary
            dict_temp.Add base(1, col), base(lin, col)
      Next

      dict.Add base(lin, 1), dict_temp
      Set dict_temp = Nothing

Next

End Sub

 

Att,

Raygsson

 
Postado : 14/11/2021 3:55 pm
AMORIM123 reacted
AMORIM123
(@amorim123)
Posts: 77
Trusted Member
Topic starter
 

@raygsson A simplicidade do teu código me mostrou o caminho que deveria seguir. Muito Obrigado, brother!!

Porém apenas pra registrar o script não foi totalmente efetivo, pois o método .ADD apresenta erro de tecla (ou chaves) já existente, então usei outro método que faz a mesma coisa, ".item()=" , tive só que alterar também a linha de código abaixo, pois isso fazia o loop ficar percorrendo apenas a primeira linha

dict_temp.Add base(1, col), base(lin, col)

Então ficou da seguinte forma ():

With Worksheets(1)

    lngUltCell = .Cells(.Rows.Count, 1).End(xlUp).Row
    
    arrRng = .Range(.Cells(2, 2), .Cells(lngUltCell, 9))
    
        For i = 1 To UBound(arrRng)
             
             For l = 1 To 8
             
                    Select Case cont
                        Case 1
                            CodProd = arrRng(i, 1)
                            DictSht(CodProd) = Array(0, 0, 0, 0, 0, 0, 0)
                        Case 2
                            DictSht(CodProd)(cont - 1) = arrRng(i, 2)
                        Case 3
                            DictSht(CodProd)(cont - 1) = arrRng(i, 3)
                        Case 4
                            DictSht(CodProd)(cont - 1) = arrRng(i, 4)
                        Case 5
                            DictSht(CodProd)(cont - 1) = arrRng(i, 5)
                        Case 6
                            DictSht(CodProd)(cont - 1) = arrRng(i, 6)
                        Case 7
                            DictSht(CodProd)(cont - 1) = arrRng(i, 7)
                        Case 8
                            DictSht(CodProd)(cont - 1) = arrRng(i, 8)
                            cont = 1
                            CodProd = ""
                            If bln Then Call FFrm_ProdVazio(CodProd)
                            bln = False
                            Exit For
                    End Select
    
                        If IsEmpty(arrRng(i, cont)) Or arrRng(i, cont) = "" Then bln = True
                        cont = cont + 1
             Next
        Next

End With
Este post foi modificado 2 anos atrás por AMORIM123
 
Postado : 14/11/2021 8:35 pm
Raygsson reacted