Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
#64624
Pessoal
Se alguem puder me ajudar/orientar.

Situação: VBA invertendo datas na hora da importação

Todo dia, preciso alimentar a planilha "TESTE1.XLSM" com os dados do arquivo "TESTEDATA.CSV".
Quando eu copio "na mão" as colunas com dados de datas, no Ctrl C + Ctrl V, funciona certinho.
Na coluna E da teste1, os dados aparecem certos(positivos).
Mas quando coloco pra rodar na macro, as datas se invertem, e a formula dependente fica com dados negativos.

Como faz a macro:
Tenho a Planilha Teste1.xlsm,
abro o arquivo Testedata.csv,
nele faço texto para colunas(Delimitado+Tabulação+Vírgula+Concluir),
Copio toda ela e Colo na Teste1

Na coluna E, Dias em Backlog, os dados ficam negativos, o correto seriam dias positivos.

Anexei os arquivos com o script tambem. (o arquivo TESTEDATA.csv.zip é um CSV, só tirar o .zip do fim)

ps: ouvi que é algo do VBA x Excel, e a função Cdate, mas nao sei como incluir ela no script.



============script
Sub Macro1()
'
' Macro1 Macro
'
'inicia fazendo a limpeza dos dados anteriores
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


ChDir "C:\Users\jackson.santos\Downloads"
Range("A1").Select

'ABRO O ARQUIVO
Workbooks.Open Filename:="C:\Users\jackson.santos\Downloads\TESTEDATA.csv"

'FACO TEXTO PARA COLUNAS: DELIMITADO + TABULAÇÃO + VIRGULA + CONCLUIR
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
'COPIO TODOS OS DADOS
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2").Select
ActiveSheet.Paste


MsgBox "FIM", vbInformation
End Sub

====

Sub Macro1()
'
' Macro1 Macro
'
'inicia fazendo a limpeza dos dados anteriores
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select


ChDir "C:\Users\simeao\Downloads"
Range("A1").Select

'ABRO O ARQUIVO
Workbooks.Open Filename:="C:\Users\simeao\Downloads\TESTEDATA.csv"

'FACO TEXTO PARA COLUNAS: DELIMITADO + TABULAÇÃO + VIRGULA + CONCLUIR
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True
'COPIO TODOS OS DADOS
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2").Select
ActiveSheet.Paste


MsgBox "FIM", vbInformation
End Sub
Você não está autorizado a ver ou baixar esse anexo.
#64631
#

substitua estas duas linhas
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
True

#
por esta
:=Array(Array(1, 1), Array(2, 1), Array(3, 2), Array(4, 2))
(as "datas" serão formatadas como texto mas as suas fórmulas na coluna E funcionarão corretamente)
#
dicas
1.acrescente ao seu código a linha em vermelho conforme abaixo
'inicia fazendo a limpeza dos dados anteriores
Application.ScreenUpdating = False
Windows("TESTE1.xlsm").Activate

#
2. a fórmula que está na coluna E ~~~> =HOJE()-(DATA(ANO(D2);MÊS(D2);DIA(D2))) pode ser simplificada para ~~~> =HOJE()-INT(D2)
JacoStein agradeceu por isso
#64634
osvaldomp escreveu:#

Osvaldo, muito grato pela prestatividade.
Ajustei o código, mas permaneceu o o erro qtde de dias negativos :(

Sou iniciante no vba, pelo que vi na net, parece ter alguma função que tem que incluir talvez, mas não sei qual e onde exatamente.
Imagem
#64635
Você pode disponibilizar o código alterado aqui no fórum?

dica - após colar o código aqui, selecione-o e clique no ícone "</>"
JacoStein agradeceu por isso
#64638
osvaldomp escreveu:Você pode disponibilizar o código alterado aqui no fórum?

dica - após colar o código aqui, selecione-o e clique no ícone "</>"
OSvaldo, Segue o código:

Sub Macro1()
'
'inicia fazendo a limpeza dos dados anteriores
Application.ScreenUpdating = False

Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2:D5000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select

ChDir "C:\Users\jackson.santos\Downloads"
Range("A1").Select

'ABRO O ARQUIVO
Workbooks.Open Filename:="C:\Users\jackson.santos\Downloads\TESTEDATA.csv"

'FACO TEXTO PARA COLUNAS: DELIMITADO + TABULAÇÃO + VIRGULA + CONCLUIR
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 2), Array(4, 2))

'COPIO TODOS OS DADOS
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2").Select
ActiveSheet.Paste

Application.ScreenUpdating = True

MsgBox "FIM", vbInformation
End Sub
#64639
Imagem

Deveria funcionar, veja a imagem acima.
No código que você disponibilizou por último eu comentei as linhas abaixo pra não precisar salvar o TESTEDATA.
'ChDir "C:\Users\jackson.santos\Downloads"
'Range("A1").Select
'
''ABRO O ARQUIVO
'Workbooks.Open Filename:="C:\Users\jackson.santos\Downloads\TESTEDATA.csv"

e acrescentei a linha abaixo no lugar
Workbooks("TESTEDATA.csv").Activate

aí rodei o código e o resultado foi correto.
Pra testar aí, mantenha aberto também o arquivo TESTEDATA.csv e rode o código.
Código: Selecionar todos
Sub Macro1()
'
'inicia fazendo a limpeza dos dados anteriores
Application.ScreenUpdating = False

Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2:D5000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select

'ChDir "C:\Users\jackson.santos\Downloads"
'Range("A1").Select
'
''ABRO O ARQUIVO
'Workbooks.Open Filename:="C:\Users\jackson.santos\Downloads\TESTEDATA.csv"

Workbooks("TESTEDATA.csv").Activate
'FACO TEXTO PARA COLUNAS: DELIMITADO + TABULAÇÃO + VIRGULA + CONCLUIR
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 2), Array(4, 2))

'COPIO TODOS OS DADOS
Range("A2:D2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("TESTE1.xlsm").Activate
Sheets("Planilha1").Select
Range("A2").Select
ActiveSheet.Paste

Application.ScreenUpdating = True

MsgBox "FIM", vbInformation
End Sub


JacoStein agradeceu por isso
#64679
Array(x,y)

x ~~~> corresponde ao número da coluna após a separação dos dados em colunas;
no seu caso a coluna 1 corresponde ao No., a coluna 2 ao SO# e as colunas 3 e 4 correspondem às colunas com datas

y ~~~> corresponde ao formato de Número a ser configurado para a coluna x;
assim, 1 equivale a Número | Geral e 2 equivale a Número | Texto

obs. o recurso de deixar as datas como Texto foi para "enganar" o VBA, pois ele "sempre pensa" nas datas no formato americano MM/DD e por isso se o dia for menor do que 13 ele muda de DD/MM para MM/DD, porém informando a ele que aquilo é Texto ele não se mete no assunto.
JacoStein agradeceu por isso
Ranking PROCV

... mas fiz as alterações correspo[…]

Bom dia comunidade! Preciso implementar uma solu&[…]

Pessoal Boa noite. Tenho uma planilha, que escrev[…]

Saldos

Olá, estou fazendo um dashboard e tenho um[…]

Deve ter outra forma, mas sugiro que faça n[…]

Tente esta: Acc = CALCULATE ( [Receita], […]

AJUDA COM FUNÇÃO "SE"

O problema não é devido ao uso da fu[…]

Veja no link abaixo se aproveita algo. https://w[…]