REDIMENSIONAR TABELA (PARA RECEBER ARRAY) A PARTIR DA ÚLTIMA LINHA COM DADOS
Enviado: 25 Mar 2022 às 11:24
No procedimento abaixo tenho um array que armazena a área com dados de uma tabela na planilha x (ShtNFe); também tenho um dicionário declarado no topo do módulo pra ficar público nesse módulo; esse dicionário contém como item: 'COD_PROD', 'DESCRICAO', 'NCM' e 'CLASSIFICACAO' e como chave: 'COD_PROD'. Faço uma comparação entre array vs dicionário para obter a CLASSIFICACAO da tecla no dicionario e repassar para o registro no array, ao final todos os registros no array estarão devidamente classificados; Para repassar a classificação para a tabela o que me importa é o último campo, porém como subi toda a tabela para memória do array precisei fazer um tratamento disso, criando um novo dicionário apenas pra esse procedimento para na sequência descarregar em novo array e ao final do loop For repassar o conteúdo inteiro, de uma só vez para coluna da tabela. Bem até aqui tudo massa!
Espero ter ser sucinto nos objetivos; sei que é um pouco complicado sugerir algo sem debugar o código, porém na real o problema se resumo a "Redimensionar Tabela apartir da Última linha com dados" para receber conteúdo de array.
Desde já agradeço a interação.
Código: Selecionar todos
Agora preciso fazer algo parecido, no sentido de descarregar um array em outra tabela (tblDefault) , sem loopar, todo o conteúdo do array a partir da linha inserida na tabela após a última linha com dados.Public Sub Apply_Rating()
Dim arrShtNFe As Variant
Dim endCell As Long
Dim i As Long
Dim arrDisc As Variant
Dim Dict As New Scripting.Dictionary
Dim arrDef As Variant
Dim rng As Range
Dim tblDefault As ListObject
Dim efinal As Long
Set tblDefault = ShtDefault.ListObjects("Default")
With ShtNFe
ShtNFe.Activate
'METODO RANGE FALHA QUANDO A PLANILHA 'NFe' NÃO ESTÁ ATIVA
endCell = .Cells(.rows.count, 1).End(xlUp).row
arrShtNFe = .Range(.Cells(2, 1), Cells(endCell, 52))
For i = LBound(arrShtNFe) To UBound(arrShtNFe)
'arrShtNFe(i, 52) = DictProcessing(CStr(arrShtNFe(i, 14)))(4)
If DictProcessing.Exists(CStr(arrShtNFe(i, 14))) Then
arrShtNFe(i, 52) = DictProcessing(CStr(arrShtNFe(i, 14)))(4)
Dict(i) = arrShtNFe(i, 52)
End If
If i >= UBound(arrShtNFe) Then
arrDisc = Dict.Items
ShtNFe.ListObjects("NFe").ListColumns(52).DataBodyRange.value = Application.transpose(arrDisc)
Dict.RemoveAll
endCell = 0
End If
Next i
End With
ShtDefault.Activate
arrDef = DictNewItemDefault.Items
tblDefault.ListRows.Add alwaysinsert:=True
efinal = tblDefault.DataBodyRange.End(xlDown).Offset(1).row
Set rng = tblDefault.Range.Offset(tblDefault.Range.rows.count).rows.Resize(DictProcessing.count)
tblDefault.DataBodyRange(efinal, 4).value = arrDef
' rng.ListColumns(2).DataBodyRange.value = Application.transpose(arrDef, 1)
' rng.ListColumns(3).DataBodyRange.value = Application.transpose(arrDef, 2)
' rng.ListColumns(4).DataBodyRange.value = Application.transpose(arrDef, 3)
End SubEspero ter ser sucinto nos objetivos; sei que é um pouco complicado sugerir algo sem debugar o código, porém na real o problema se resumo a "Redimensionar Tabela apartir da Última linha com dados" para receber conteúdo de array.
Desde já agradeço a interação.
, porém como os dados de origem eram um vetor o propósito nunca seria alcançado, né (rsrsrs).