ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

REDIMENSIONAR TABELA (PARA RECEBER ARRAY) A PARTIR DA ÚLTIMA LINHA COM DADOS

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
RAFAEL AMORIM
Colaborador
Colaborador
Mensagens: 69
Registrado em: Sáb Jul 22, 2017 10:17 am

REDIMENSIONAR TABELA (PARA RECEBER ARRAY) A PARTIR DA ÚLTIMA LINHA COM DADOS

Mensagem por RAFAEL AMORIM »

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!

Código: Selecionar todos

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
        
    tblDefault.Range.Offset(tblDefault.Range.rows.count).rows.Resize(DictProcessing.count, 4).value = arrDef

	'DETALHE: Preciso que o objeto que receba os dados do array seja uma tabela, pois essa tabela será 		 
        'manipulada no power pivot na sequência.
    
End Sub
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.

Imagem

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.
Anexos
RESIZE TABLE.png
RESIZE TABLE.png (86.79 KiB) Exibido 249 vezes


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder