Ir ao conteúdo
  • Cadastre-se

ErickSant

Membros Plenos
  • Total de itens

    56
  • Registro em

  • Última visita

  • Qualificações

    N/D
  1. Boa tarde, Tenho o seguinte código para importar arquivos automaticamente no Access... Eu precisava criar uma validação para impedir que fosse importado registros repetidos... Minha dúvida seria criar alguma regra que impedisse que eu imputasse registros repetidos... Private Sub btn_01_Click() nome = Dir("C:\*.xlsx") planilha = "C:\" & nome 'CurrentDb.Execute "DELETE * FROM Radares" 'limpa a tabela antes de importar Set dbLocal = CurrentDb 'banco atual Set myRec = CurrentDb.OpenRecordset("Radares") 'abre a tabela que você escolher Set dbExcel = OpenDatabase(planilha, False, True, "Excel 8.0; HDR=NO; IMEX=1;") 'abre o excel Set rsExcel = dbExcel.OpenRecordset("Instrumentos$") 'rsExcel.MoveNext 'começa a pegar da segunda linha do excel Do While Not rsExcel.EOF If rsExcel.Fields("F1") = "Municipio" Then rsExcel.MoveNext End If myRec.AddNew 'adiciona uma linha na tabela myRec.Fields("Municipio") = rsExcel.Fields("F1") myRec.Fields("NumInmetro") = rsExcel.Fields("F2") myRec.Fields("Local") = rsExcel.Fields("F4") myRec.Fields("DataVerificacao") = rsExcel.Fields("F5") myRec.Fields("DataValidade") = rsExcel.Fields("F6") myRec.Update rsExcel.MoveNext Loop rsExcel.Close Set rsExcel = Nothing dbExcel.Close Set dbExcel = Nothing 'caminhoresultado = "C:\" 'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Encontrados", caminhoresultado, True MsgBox ("Importado com sucesso!") 'Debug.Print (caminho) End Sub Alguém consegue me ajudar ?
  2. era isso mesmo cara! Muito obrigado!
  3. Prezados, boa tarde, Venho com mais uma dúvida, a lógica dessa vez é a seguinte, há a coluna de descrição e a coluna de valor... A ideia é pegar caso o valor termine com a letra D, pegue a segunda linha da descrição, recorte e cole na linha da descrição do valor... (esse é o primeiro loop) O segundo loop seria apagar todas linhas que não possuem descrição... Vendo meu anexo acredito que ficaria muito mais fácil o entendimento... Na planilha2 coloquei como teria que ficar... Alguém consegue me ajudar ? teste.xlsx
  4. Fala @R0DR1G0_CWB não to conseguindo te mandar mensagem privada... Não mandei com o vba porque a ideia é bem 'simples', to mandando agora com o código que tentei fazer... O objetivo é filtrar tudo da coluna A diferente dos números que coloquei nos critérios... Que são: 27001101 27001102 27001103 27001104 27001105 27001106 27001201 27001202 27001203 27001204 27001205 e também não pegar os campos vazios Segue o anexo... Pasta1.zip
  5. Amigos, boa tarde, Tenho uma dúvida que para muitos acredito que será fácil, mas eu estou quebrando a cabeça e não consigo resolver... Possuo 4 bases enormes em excel onde possuem diversas colunas, a ideia é dessas 4 bases, retirar apenas algumas colunas específicas e jogar em um layout pronto já do Excel... Porém algumas colunas desse layout, possuem fórmula de concatenação e uma outra de conversão de valor(real para Euro)... Eu queria tentar fazer isso em Access, onde no Access eu já teria a tabela do layout pronta e exportaria todas bases do excel la e rodaria alguma query... Alguém já fez algo parecido ?
  6. Corrigindo, sua resposta acima estava certa! OBRIGADO! RESOLVIDO!
  7. Bom dia Rodrigo! Obrigado pelo retorno até aqui! Verificando com o resultado que foi feito na mão, alguns pequenos valores não entraram na macro, fiz alguns testes na planilha 2, verifique meu anexo por favor... A soma da coluna Erro teria que dar: 169.573,43 Obrigado!! Teste versão Feito.zip
  8. @R0DR1G0_CWB Fala cara, beleza? Eu testei o seu código, ele praticamente da o mesmo 'erro'... Veja meu anexo, se você pegar por exemplo, depois de rodar a macro do status, o valor 12,5... Vai encontrar alguns valores desse negativo mas cade o positivo ? A ideia é deixar com o status OK, somente os números que se cruzam, ou seja, esses que estão com ok, na verdade deveriam estar com erro... Fazendo essa conciliação no olho, verifiquei que o número de Errados é de 178, ou seja, são alguns que estão com 'ok' mas que na verdade deveriam estar como 'erro' também... Pasta1.zip
  9. Amigos, bom dia, Eu havia marcado esse tópico como resolvido, porém analisando de novo a planilha, me deparei que ainda constam valores que deveriam estar com o status 'OK' mas não ficaram... É como se o código só faz o calculo quando há um número positivo seguido de um negativo, quando há por exemplo, dez números positivos e depois de outros números aleatórios terem esses mesmos 10 números negativos, ele não altera o status deles... Vejam meu anexo por favor... Alguém consegue me ajudar ? teste.zip adicionado 7 minutos depois Em uma outra época, um amigo fez um código em vba para mim, onde conciliava valores que se repetiam na mesma coluna, por exemplo, há 10 valores positivos e 10 valores negativos, dai essa macro ela pintava todos os 20 valores de uma cor específica.... Não sei se daria para adptar esse código para minha nova necessidade... Segue: Sub conciliar() On Error Resume Next Dim ul As Long 'inicio: ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To ul conf1 = CStr(Cells(i, 7).Value & Cells(i, 8).Value) For j = 2 To ul If CStr(Cells(j, 7).Value & (Cells(j, 8).Value) * -1) = conf1 And Cells(j, 7).Row <> Cells(i, 7).Row Then Cells(j, 2).EntireRow.Interior.Color = 65535 Cells(i, 2).EntireRow.Interior.Color = 65535 'GoTo inicio End If Next j Next i MsgBox "Conciliação realizada com Sucesso!", vbExclamation, "Sucesso!" End Sub
  10. prezados, bom dia, Quando baixo algum arquivo da internet, automaticamente abre a tela de pergunta se quero salvar o arquivo ou apenas abri-lo... Existe alguma configuração onde eu consigo tirar essa pergunta e salvar direto o arquivo em meu computador?(downloads) Ou alguém sabe me informar qual seria o nome do botão 'save'(código)? Obrigado!
  11. Prezados, boa tarde, Preciso fazer uma lógica onde calcule 1 valor menos o valor seguinte, CASO a conta dar 0, ir na outra coluna de Status e marcar nas 2 linhas como "Ok", caso der diferente de 0, marcar como "erro"... O problema dessa vez, é que podem ter casos que por exemplo, ao invés de ter um número positivo dps o mesmo número negativo, podem ter o mesmo número positivo 10x e em seguida o mesmo número negativo 10x, fazendo assim q eles se eliminem... Vejam meu anexo para melhor entendimento... No meu anexo eu já rodei a macro mas para verificar o arquivo sem a macro rodada, só substituir todo o conteúdo da coluna B por "0".. Verão que há valores que se eliminam mas continuam sem o "OK" dps de rodar a macro... teste.zip
  12. Bom dia, na verdade não, segue o código que realmente me ajudou. Sub Status() Dim ul As Long inicio: ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To ul If Planilha1.Range("B" & i) <> "OK" And Planilha1.Range("A" & i).Value = Planilha1.Range("A" & i + 1).Value * -1 Then Planilha1.Range("B" & i).Value = "OK" Planilha1.Range("B" & i + 1).Value = "OK" End If Next i For i = 2 To ul If Planilha1.Range("B" & i).Value = "" Then Planilha1.Range("B" & i).Value = "Erro" End If Next i End Sub Mesmo assim, obrigado pela ajuda cara!
  13. mas se você verificar o arquivo dos valores até o final, vão ter casos que tem mais positivos que negativos... A ideia é que depois de rodar a macro, tudo que estiver com status Ok, a soma da coluna dar zero Veja como consegui fazer até agr por macro... Consegue me ajudar a corrigir ? teste.zip
  14. Prezados, bom dia, Tenho uma nova dúvida, acredito que essa é mais fácil... Preciso fazer uma lógica onde calcule 1 valor menos o valor seguinte, CASO a conta dar 0, ir na outra coluna de Status e marcar nas 2 linhas como "Ok", caso der diferente de 0, marcar como "erro"... Vejam meu anexo, acredito que ficaria mais fácil o entendimento... Lembro que há um tempo atrás me ajudaram com um problema parecido com o seguinte código: Sub conciliar() On Error Resume Next Dim ul As Long 'inicio: ul = Planilha1.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To ul conf1 = CStr(Cells(i, 7).Value & Cells(i, 8).Value) For j = 2 To ul If CStr(Cells(j, 7).Value & (Cells(j, 8).Value) * -1) = conf1 And Cells(j, 7).Row <> Cells(i, 7).Row Then Cells(j, 2).EntireRow.Interior.Color = 65535 Cells(i, 2).EntireRow.Interior.Color = 65535 'GoTo inicio End If Next j Next i MsgBox "Conciliação realizada com Sucesso!", vbExclamation, "Sucesso!" End Sub Obrigado! teste.xlsx
  15. Olá, bom dia, Achei o seguinte código na internet, mas não estou conseguindo adaptar o Range... Alguém consegue me ajudar ? Option Explicit Sub export_in_json_format() Dim fs As Object Dim jsonfile Dim rangetoexport As Range Dim rowcounter As Long Dim columncounter As Long Dim linedata As String ' change range here Set rangetoexport = Worksheets("Sheet1").Range("E1", "G1", "H1", "L1", "N1", "O1", "P1") << eu precisaria dessas colunas apenas... Set fs = CreateObject("Scripting.FileSystemObject") ' change dir here Set jsonfile = fs.CreateTextFile("C:\Users\Erick\Desktop\" & "jsondata.json", True) linedata = "{""Output"": [" jsonfile.WriteLine linedata For rowcounter = 2 To rangetoexport.Rows.Count linedata = "" For columncounter = 1 To rangetoexport.Columns.Count linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & "," Next linedata = Left(linedata, Len(linedata) - 1) If rowcounter = rangetoexport.Rows.Count Then linedata = "{" & linedata & "}" Else linedata = "{" & linedata & "}," End If jsonfile.WriteLine linedata Next linedata = "]}" jsonfile.WriteLine linedata jsonfile.Close Set fs = Nothing End Sub Galera, acredito que estou chegando perto do que eu desejo... Vejam o código abaixo por favor. Sub export_in_json_format() Dim fs As Object Dim jsonfile Dim rangetoexport As Range Dim rowcounter As Long Dim columncounter As Long Dim linedata As String Dim UltimaLinhaAtivaE As Long Dim UltimaLinhaAtivaG As Long Dim UltimaLinhaAtivaH As Long Dim UltimaLinhaAtivaL As Long Dim UltimaLinhaAtivaN As Long Dim UltimaLinhaAtivaO As Long Dim UltimaLinhaAtivaP As Long UltimaLinhaAtivaE = Planilha1.Cells(Planilha1.Rows.Count, 5).End(xlUp).Row UltimaLinhaAtivaG = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaH = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaL = Planilha1.Cells(Planilha1.Rows.Count, 12).End(xlUp).Row UltimaLinhaAtivaN = Planilha1.Cells(Planilha1.Rows.Count, 14).End(xlUp).Row UltimaLinhaAtivaO = Planilha1.Cells(Planilha1.Rows.Count, 15).End(xlUp).Row UltimaLinhaAtivaP = Planilha1.Cells(Planilha1.Rows.Count, 16).End(xlUp).Row ' range Set rangetoexport = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN, "E1:E" & UltimaLinhaAtivaE) 'AQUI se eu configurar até 2 colunas( N e E) ele passa tranquilo e faz exatamente o que eu quero... Porém se eu colocar na ordem que eu quero, ele da erro... 'a ordem das colunas que eu quero colocar é N, O, P, H, G, L, E 'no caso seguiria a mesma lógica 'exemplo 'Set rangetoexport = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN, "O1:O" & UltimaLinhaAtivaO, "P1:P" & UltimaLinhaAtivaP, "H1:H" & UltimaLinhaAtivaH, "G1:G" & UltimaLinhaAtivaG, "L1:L" & UltimaLinhaAtivaL, "E1:E" & UltimaLinhaAtivaE) Alguém consegue me ajudar ?? até consegui ajeitar, mas o resultado ele ignora algumas colunas... Option Explicit Sub export_in_json_format() Dim fs As Object Dim jsonfile Dim rangetoexport As Range Dim rowcounter As Long Dim columncounter As Long Dim linedata As String Dim UltimaLinhaAtivaE As Long Dim UltimaLinhaAtivaG As Long Dim UltimaLinhaAtivaH As Long Dim UltimaLinhaAtivaL As Long Dim UltimaLinhaAtivaN As Long Dim UltimaLinhaAtivaO As Long Dim UltimaLinhaAtivaP As Long Dim r1 As Range Dim r2 As Range Dim r3 As Range Dim r4 As Range Dim r5 As Range Dim r6 As Range Dim r7 As Range UltimaLinhaAtivaE = Planilha1.Cells(Planilha1.Rows.Count, 5).End(xlUp).Row UltimaLinhaAtivaG = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaH = Planilha1.Cells(Planilha1.Rows.Count, 7).End(xlUp).Row UltimaLinhaAtivaL = Planilha1.Cells(Planilha1.Rows.Count, 12).End(xlUp).Row UltimaLinhaAtivaN = Planilha1.Cells(Planilha1.Rows.Count, 14).End(xlUp).Row UltimaLinhaAtivaO = Planilha1.Cells(Planilha1.Rows.Count, 15).End(xlUp).Row UltimaLinhaAtivaP = Planilha1.Cells(Planilha1.Rows.Count, 16).End(xlUp).Row Set r1 = Worksheets("Sheet1").Range("N1:N" & UltimaLinhaAtivaN) Set r2 = Worksheets("Sheet1").Range("O1:O" & UltimaLinhaAtivaO) Set r3 = Worksheets("Sheet1").Range("P1:P" & UltimaLinhaAtivaP) Set r4 = Worksheets("Sheet1").Range("H1:H" & UltimaLinhaAtivaH) Set r5 = Worksheets("Sheet1").Range("G1:G" & UltimaLinhaAtivaG) Set r6 = Worksheets("Sheet1").Range("L1:L" & UltimaLinhaAtivaL) Set r7 = Worksheets("Sheet1").Range("E1:E" & UltimaLinhaAtivaE) ' change range here Set rangetoexport = Union(r1, r2, r3, r4, r5, r6,r7) Set fs = CreateObject("Scripting.FileSystemObject") ' change dir here Set jsonfile = fs.CreateTextFile("C:\Users\erick.l.santiago\Desktop\" & "jsondata.json", True) linedata = "{""Output"": [" jsonfile.WriteLine linedata For rowcounter = 2 To rangetoexport.Rows.Count linedata = "" For columncounter = 1 To rangetoexport.Columns.Count linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & "," Next linedata = Left(linedata, Len(linedata) - 1) If rowcounter = rangetoexport.Rows.Count Then linedata = "{" & linedata & "}" Else linedata = "{" & linedata & "}," End If jsonfile.WriteLine linedata Next linedata = "]}" jsonfile.WriteLine linedata jsonfile.Close Set fs = Nothing End Sub 'resultado': {"Output": [ {"Supplier Number":"20136570","Supplier Number Desc":"fornecedor1","Invoice Number":""}, {"Supplier Number":"40016609","Supplier Number Desc":"fornecedor2","Invoice Number":"000050412000"}, {"Supplier Number":"40018644","Supplier Number Desc":"fornecedor3","Invoice Number":"10006600"}, {"Supplier Number":"40017433","Supplier Number Desc":"fornecedor4","Invoice Number":"00912200"}, {"Supplier Number":"40017966","Supplier Number Desc":"fornecedor5","Invoice Number":"00055900"} ]} O certo era trazer mais algumas informações...

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×