Rudieres Cunha

Bom dia! Por favor, me ajudem. Já tentei de tudo e fiz diversas pesquisas sem solução. Tenho um código vba todo pronto. Porém, o único problema, é que o arquivo original é em formato csv/txt. Quando abro o arquivo clicando normalmente, ele não inverte as datas na coluna F por exemplo. Porém, ao utilizar o codigo VBA ele inverte logo ao realizar o comando para abrir o arquivo, impossibilitando de aplicar soluções como vba.format, format, cdate, etc.... Impossibilita porque ele altera a data só até o dia 12 de cada mês, porque não existe mês 13..Então é como se ficassem 2 formatos no arquivos, um brasileiro e 1 americano. Ou seja, ele já abre o arquivo lendo o mês errado. PlanilhaModelo ArquivoRodarNaPlanilha Segue código e arquivos modelo para testes em anexo. Muito obrigado. Public CaminhoArquivo, NomeDoArquivo, NomeDoArquivoComExtensao, Aba As Variant 'Public: Declaração de variável global, ou seja, disponível para qualquer rotina deste projeto. Option Explicit Sub AtualizarmovT99Nv() Call OpenFileDialog End Sub Public Function OpenFileDialog() As String Application.ScreenUpdating = False Application.DisplayAlerts = False ActiveSheet.DisplayPageBreaks = False 'Desabilita as quebras de páginas Dim Filter As String, Title As String Dim FilterIndex As Integer Dim Filename As Variant Dim Aba As Variant ' Define o filtro de procura dos arquivos Filter = "Arquivos Excel (*.xls*),*.xl*," ' O filtro padrão é *.* FilterIndex = 4 ' Define o Título (Caption) da Tela Title = "Selecione o arquivo correspondente ao Cadastro de Produtos" ' Define o disco de procura ChDrive ("C") ChDir ("C:\Users") With Application ' Abre a caixa de diálogo para seleção do arquivo com os parâmetros Filename = .GetOpenFilename(Filter, FilterIndex, Title) ' Reseta o Path ChDrive (Left(.DefaultFilePath, 1)) ChDir (.DefaultFilePath) End With ' Abandona ao Cancelar If Filename = False Then MsgBox "Nenhum arquivo foi selecionado." Exit Function End If ' Retorna o caminho do arquivo OpenFileDialog = Filename CaminhoArquivo = Filename Dim Pergunta As VbMsgBoxResult Pergunta = MsgBox("Deseja realmente abrir o arquivo " & CaminhoArquivo & "?", vbYesNo + vbQuestion, "Abrir Arquivo") If Pergunta = vbYes Then 'Apagar a primeira linha para subscrever nova ramificação de pasta Sheets("CaminhoArquivo").Visible = True Sheets("CaminhoArquivo").Select Rows("1:1").Select Selection.Delete Shift:=xlUp 'Transcreve o endereço do arquivo para a celula a1 Sheets("CaminhoArquivo").Range("A1").Value = CaminhoArquivo Sheets("CaminhoArquivo").Range("A1").Select 'Clica na celula do A1 'Procedimento texto para colunas Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="\", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ TrailingMinusNumbers:=True 'Procedimento para retornar somente o nome do arquivo 'A função replace equivale a substituir NomeDoArquivo = VBA.Replace(VBA.Replace(Sheets("CaminhoArquivo").Cells(1, Application.CountA(Sheets("CaminhoArquivo").Range("1:1"))).Value, ".xls", ""), ".xlsx", "") Sheets("CaminhoArquivo").Activate ActiveWindow.SelectedSheets.Visible = False Sheets("movT99").Activate Else MsgBox "Proceder nova abertura", vbCritical, "Abrir arquivo" End If Call FormatarCadastro 'Call Atualizar MsgBox ("movT99 atualizada com sucesso!") Application.ScreenUpdating = True Application.DisplayAlerts = True End Function Sub FormatarCadastro() Dim NomeDesseArquivo, TotalLinhasCustInv, DataHora, Linhas, _ TotalLinhasmovT99, TotalLinhasFormulas, Aba, TotalLinhas As Variant Dim CaixaTexto As String 'Capta o nome deste projeto, ou seja, 02 fevereiro.xlsm NomeDesseArquivo = ActiveWorkbook.Name 'Limpar área movT99 analítico Windows(NomeDesseArquivo).Activate 'Procedimento para abrir pasta de trabalho Workbooks.Open Filename:=CaminhoArquivo NomeDoArquivoComExtensao = ActiveWorkbook.Name Aba = ActiveSheet.Name TotalLinhas = Sheets(Aba).Range("A" & Rows.Count).End(xlUp).Row Sheets(Aba).Activate '-------------------------------------------------------------------------------------------------------------- 'Formatar arquivo para copiar Range("A:A,E:E,H:H,J:J,K:K,L:L,M:M,N:N,P:P,Q:Q,U:X").Delete Shift:=xlToLeft '-------------------------------------------------------------------------------------------------------------- TotalLinhas = Sheets(Aba).Range("A" & Rows.Count).End(xlUp).Row Range("A2:J" & TotalLinhas).Copy Windows(NomeDesseArquivo).Activate Sheets("movT99").Activate TotalLinhasmovT99 = Sheets("movT99").Range("N" & Rows.Count).End(xlUp).Row TotalLinhasFormulas = Sheets("movT99").Range("K" & Rows.Count).End(xlUp).Row Range("N" & TotalLinhasmovT99 + 1).PasteSpecial 'DoEvents 'Aguardar o processamento anterior para processar a px linha Windows(NomeDoArquivoComExtensao).Activate ActiveWindow.Close savechanges:=False TotalLinhasmovT99 = Sheets("movT99").Range("N" & Rows.Count).End(xlUp).Row 'Range(Cells(TotalLinhasFormulas + 1, 1), Cells(TotalLinhasmovT99, 1)).Value = CaixaTexto 'Range(Cells(TotalLinhasFormulas + 1, 1), Cells(TotalLinhasmovT99, 1)) = VBA.Format(CaixaTexto, "mm/dd/yyyy") 'Application.Calculation = xlCalculationManual ' Range(Cells(TotalLinhasFormulas + 1, 9), Cells(TotalLinhasmovT99, 9)).Value = "=IF(AND(ISNA(IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4])),RC[-6]<>11,RC[-6]<>0),""Atualizar movT99 custo"",IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4]))" ' Range(Cells(TotalLinhasFormulas + 1, 10), Cells(TotalLinhasmovT99, 10)).Value = "=IF(AND(ISNA(IF(OR(RC[-7]=11,RC[-7]=0),0,INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0)))),RC[-7]<>11,RC[-7]<>0),""Atualizar movT99 Linha Resumida"",IF(OR(RC[-7]=11,RC[-7]=0),"""",INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0))))" ' Range(Cells(TotalLinhasFormulas + 1, 11), Cells(TotalLinhasmovT99, 11)).Value = "=IFERROR(IFERROR(VLOOKUP(RC[-9],Tabela2[#All],2,0),VLOOKUP(RC[-4],Tabela2[#All],2,0)),RC[-4])" 'Range("I" & TotalLinhasFormulas + 1).Value = "=IF(AND(ISNA(IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4])),RC[-6]<>11,RC[-6]<>0),""Atualizar movT99 custo"",IF(OR(RC[-6]=11,RC[-6]=0),0,VLOOKUP(movT99!RC[-6],Tabela1[[#All],[ITEM]:[CUSTO_INV]],7,0)*movT99!RC[-4]))" 'Range("J" & TotalLinhasFormulas + 1).Value = "=IF(AND(ISNA(IF(OR(RC[-7]=11,RC[-7]=0),0,INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0)))),RC[-7]<>11,RC[-7]<>0),""Atualizar movT99 Linha Resumida"",IF(OR(RC[-7]=11,RC[-7]=0),"""",INDEX(Tabela1[[#All],[LINHA RESUMIDA]],MATCH(RC[-7],Tabela1[[#All],[ITEM]],0))))" 'Range("K" & TotalLinhasFormulas + 1).Value = "=IFERROR(IFERROR(VLOOKUP(RC[-9],Tabela2[#All],2,0),VLOOKUP(RC[-4],Tabela2[#All],2,0)),RC[-4])" Range("K" & TotalLinhasFormulas + 1).Value = "=HOUR(RC[6])" Range("L" & TotalLinhasFormulas + 1).Value = "=INT(RC[5])" Range("M" & TotalLinhasFormulas + 1).Value = "=RC[1]&RC[2]&RC[9]" Range(Cells(TotalLinhasFormulas + 1, 11), Cells(TotalLinhasFormulas + 1, 13)).Copy Destination:=Range(Cells(TotalLinhasFormulas + 2, 11), Cells(TotalLinhasmovT99, 13)) Calculate 'Application.Calculation = xlCalculationAutomatic Range(Cells(TotalLinhasFormulas, 11), Cells(TotalLinhasmovT99, 13)).Value = Range(Cells(TotalLinhasFormulas, 11), Cells(TotalLinhasmovT99, 13)).Value End Sub