Este fórum está sendo desativado

[RubensOliveiraSSA]

Bom dia!
Tenho uma rotina que está demorando mais de duas horas para atualizar uma planilha.
Resolvi fazer a atualização usando arrays. Inicialmente transfiro o range de toda planilha Tabela pra um array.
Ao tentar colocar uma fórmula dentro do array Atb1(cont_pr,6), retorna um erro em tempo de execução dizendo que o objeto é obrigatório. Não consegui descobri um jeito de colocar a fórmula dentro do array. Anexei o arquivo Teste.xlsb com três planilhas, sendo: Tabela: planilha de trabalho, Protheus: Planilha com os novos dados e Temp: Planilha onde será armazenados os dados atualizados. Abaixo o código que estou usando. Agradeceria se alguém pudesse encontrar uma maneira de colocar a fórmula no array.

Sub atualiza()
Application.StatusBar = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim nf_pr, nf_tb As String
Dim cnt_pr, cnt_pr1 As Integer
Dim LastCol_tb, LastCol_pr, LastRow_plan_tb, LastRow_tab_tb, LastRow_plan_pr, LastRow_tab_pr As Long
Dim Atb(), Atb1(), Apr() As Variant
Dim encontrado As Boolean
Set pr = Sheets("Protheus")
Set tb = Sheets("Tabela")
Set tmp = Sheets("Temp")
LastRow_plan_tb = tb.Range("A1").SpecialCells(xlCellTypeLastCell).Row
LastRow_tab_tb = tb.Cells(tb.Rows.Count, "A").End(xlUp).Row - 1
LastRow_plan_pr = pr.Range("A1").SpecialCells(xlCellTypeLastCell).Row
LastRow_tab_pr = pr.Cells(pr.Rows.Count, "A").End(xlUp).Row - 1
LastCol_tb = tb.UsedRange.Columns.Count
LastCol_pr = pr.UsedRange.Columns.Count
ReDim Atb(1 To LastCol_tb, 1 To LastRow_tab_tb)
Atb = tb.Range("A3:L" & LastRow_tab_tb).Value 'coloca todos os dados da planilha Tabela na memória
ReDim Atb1(1 To LastRow_tab_tb + LastRow_tab_tb, 1 To LastCol_tb)
ReDim Apr(1 To LastCol_tb, 1 To LastRow_tab_pr)
Apr = pr.Range("A3:J" & LastRow_tab_pr).Value 'coloca todos os dados da planilha Protheus na memória
For cnt_pr = 1 To UBound(Apr)
Application.StatusBar = "Pesquisando linha: " & " -> " & cnt_pr & " de " & UBound(Apr)
nf_pr = Apr(cnt_pr, 1) 'coloca numero da NF na variavel NF
encontrado = False
cnt_pr1 = 1
Do While cnt_pr1 <= UBound(Atb)
nf_tb = Atb(cnt_pr1, 7)
If nf_pr = nf_tb Then
Atb1(cnt_pr, 1) = Apr(cnt_pr, 10) ' Status
Atb1(cnt_pr, 2) = Apr(cnt_pr, 4) 'comprador
Atb1(cnt_pr, 3) = Atb(cnt_pr1, 3) 'representante
Atb1(cnt_pr, 4) = Atb(cnt_pr1, 4) 'UF de Origem
Atb1(cnt_pr, 5) = Apr(cnt_pr, 6) 'UF de Entrega
Atb1(cnt_pr, 6).FormulaArray = "{=IF([@STATUS]=""Em Aberto"",TODAY()-[@Emissão],"""")}"
Atb1(cnt_pr, 7) = Apr(cnt_pr, 1) 'número da NF
Atb1(cnt_pr, 8) = Apr(cnt_pr, 3) 'data de emissão
Atb1(cnt_pr, 9) = Apr(cnt_pr, 5) 'valor
Atb1(cnt_pr, 10) = Apr(cnt_pr, 7) 'valor do pagamento
Atb1(cnt_pr, 11) = Apr(cnt_pr, 9) 'data do pagamento
Atb1(cnt_pr, 12) = Apr(cnt_pr, 8) 'saldo
encontrado = True
Exit Do
End If
cnt_pr1 = cnt_pr1 + 1
Loop 'cnt_pr1
If Not encontrado Then
Atb1(cnt_pr, 1) = Apr(cnt_pr, 10) ' Status
Atb1(cnt_pr, 2) = Apr(cnt_pr, 4) 'comprador
Atb1(cnt_pr, 3) = "" 'representante
Atb1(cnt_pr, 4) = "" 'UF de Origem
Atb1(cnt_pr, 5) = Apr(cnt_pr, 6) 'UF de Entrega
Atb1(cnt_pr, 6).FormulaArray = "{=IF([@STATUS]=""Em Aberto"",TODAY()-[@Emissão],"""")}"
Atb1(cnt_pr, 7) = Apr(cnt_pr, 1) 'número da NF
Atb1(cnt_pr, 8) = Apr(cnt_pr, 3) 'data de emissão
Atb1(cnt_pr, 9) = Apr(cnt_pr, 5) 'valor
Atb1(cnt_pr, 10) = Apr(cnt_pr, 7) 'valor do pagamento
Atb1(cnt_pr, 11) = Apr(cnt_pr, 9) 'data do pagamento
Atb1(cnt_pr, 12) = Apr(cnt_pr, 8) 'saldo
End If
Next cnt_pr
On Error Resume Next
tmp.Range(Cells(3, 1), Cells(UBound(Atb1), LastCol_tb)) = Atb1
Application.StatusBar = False
End Sub

[babdallas]

Veja se o que eu fiz te ajuda.

[RubensOliveiraSSA]

Bom dia, Babdallas!
Agradeço-lhe a pronta resposta mas, não atende ao que preciso e lhe explico o porque.
Estou usando o Office 2016 e não sei porque a gravação célula por célula fica extremamente lenta. A aba tabela, originalmente, conta com mais de 6 mil linhas. Se for fazer uma transferência usando o loop que você criou vai demorar umas duas horas. Por isso, tenho que transferir o intervalo inteiro do array Atb1 para a aba Temp. A aba Temp é usada para receber os dados atualizados da aba Tabela e dos novos lançamentos da aba Protheus. O resultado disso coloco no array ATab1 e para que o resultado seja otimizado quero gravar o array inteiro num intervalo de células em Temp. Então minha ideia é, depois de obtido o resultado na aba Temp com os dados já existentes e atualizados de Tabela e os novos da aba Protheus, remover a aba Tabela, transformar a aba Temp em uma tabela e mudar o nome dela para Tabela. Por isso preciso que a fórmula nos arrays sejam transferidas para a aba Temp de uma vez só (digo, em um só intervalo, sendo que esse intervalo equivale a todo o array Atb1). Você acha que é possível fazer da maneria que estou pensando ou vou ter que mudar todo o algoritmo? Agradeço-lhe mais uma vez e fico no aguardo. Rubens.

[babdallas]

Tente inserir a fórmula dentro da array como string. No final, vc faz: range(coluna com a string).Fórmula = range(coluna com a string de fórmula).Value
Se não der certo, na hora do almoço eu tento aqui.

[RubensOliveiraSSA]

Bom dia, Babdallas.
Consegui resolver o problema da seguinte forma:
Fiz a importação das duas planilhas para a planinha Temp, sem levar as formulas.
Tenho no total 10 fórmulas. Adicionei elas no final.
Veja o exemplo a seguir:
tb.Cells(3, 8).Formula = "=IF(AND([@STATUS]=""EM ABERTO"",[@STATUS]<>""""),IF(TODAY()-[@VCTO]<=45,0,TODAY()-[@VCTO]-45),IF([@VCTO]="""","""",IF([@STATUS]=""Devolvida"",0,IF([@[Valor Pago]]<>"""",""quitada"",0))))" 'Dias em Aberto
Como essa é a primeira linha da tabela, a mesma é replicada para todas as outras linhas.
Pode não ter sido a maneira mais elegante de resolver, mas está funcionando.
Vou considerar o tópico como resolvido e lhe agradecer pela atenção.
Rubens.