Ir ao conteúdo
  • Cadastre-se

OreiaG

Membro Pleno
  • Posts

    293
  • Cadastrado em

Tudo que OreiaG postou

  1. Eu suponho que o erro irá ocorrer se o seu VLookup não encontrar o valor procurado, então o erro poderá ocorrer também nas duas primeiras condições e não só na terceira. E o uso de On Error Resume Next poderá "permitir" resultado falso na coluna F. Exemplo: considerando que o preenchimento de A1:D17 seja manual, e considerando que o intervalo F1:F17 está preenchido corretamente. Agora você altera o valor em B1 de 3 para 20 e altera qualquer valor em A1:A17. Se o valor 20 não for encontrado, o VLookup irá retornar erro e o valor em F1 não será atualizado pelo código em decorrência do On Error Resume Next, ou seja, F1 terá um valor falso. Talvez uma forma de contornar seja executar o código ao alterar qualquer coluna de A até D, e não somente ao alterar A, limpar antes o valor em F e assim em caso de erro F ficará vazia (ou pode colocar mensagem indicando que ocorreu erro). Seria conveniente também que o código atualizasse F somente na linha alterada em A:D, ao invés de executar Loop em todas as linhas a cada alteração manual, conforme seu código original.
  2. @deejaywesley Veja se este lhe atende. Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long If Not Intersect([A1:A17], Target) Is Nothing Then For i = 2 To 17 If Cells(i, "B") <> "" Then Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "B").Value, Sheets("Plan2").[A1:B17], 2, 0) ElseIf Cells(i, "C") <> "" Then Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "C").Value, Sheets("Plan3").[A1:B17], 2, 0) Else: Cells(i, "F").Value = Application.WorksheetFunction.VLookup(Cells(i, "D").Value, Sheets("Plan4").[A1:B17], 2, 0) End If Next i End If End Sub
  3. Baixei o seu novo arquivo e confesso que não consegui sair do zero entendimento sobre o que você quer fazer. Um palpite: as suas fórmulas estão retornando os resultados desejados, porém devido à grande quantidade de fórmulas necessárias na planilha você quer colocar via macro os respectivos valores e não as fórmulas. Seria isso que você quer? Outra dúvida: os valores da tabela do meio da Plan1 são diferentes dos valores da tabela do meio da Plan2 ? Qual a conclusão que devemos tirar disso ?
  4. @Sergio.Valente Olá. "passar algumas fórmulas Excel de uma tabela de análise para código de Vba" O que exatamente você quer fazer ? Qual o resultado desejado na planilha que você anexou ?
  5. Realmente, agora notei que ao concatenar, o código está colocando 2 espaços a mais. Seria essa a diferença em relação ao seu resultado ? Se for, então elimine os espaços em >>> & " - " & Deverá ficar assim >>> & "-" &
  6. @deejaywesley Veja se este lhe atende. Sub OrdenaDados() Dim k As Long, D As Variant, R As Variant Application.ScreenUpdating = False [D:E] = "" Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Copy [D2] Columns(4).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="-" Range("D2", Cells(Rows.Count, 5).End(3)).Sort Key1:=[E2], Order1:=xlAscending D = Range("D2", Cells(Rows.Count, 5).End(3)) ReDim R(1 To UBound(D), 1 To 1) For k = 1 To UBound(D) R(k, 1) = D(k, 1) & " - " & D(k, 2) Next Range("D2").Resize(UBound(R)) = R Columns(4).AutoFit: [E:E] = "" End Sub Considerei os dados a partir de B2; o resultado será colocado a partir de D2.
  7. Você testou o arquivo que anexei no Post #27 ? Se você quiser instalar o código no arquivo aí faça assim: a) copie o código do Post # 21 b) clique com o direito na guia da planilha Consulta a um Piloto e selecione Exibir Código c) cole o código no módulo em branco, faça a correção (elimine o "A") d) feche o VBA e faça os testes
  8. Veja se lhe ajuda: pesquisa Google >>> excel - macros funcionam no 64 bits mas não no 32 bits compatibilizar 64 x 32
  9. Ok, cole o código abaixo no módulo da planilha Consulta a um Piloto, antes apague outros códigos existentes no módulo citado. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$B$3" Then [A8:B506] = "" ElseIf Not Intersect(Target, [A8:B506,D8:D506]) Is Nothing Then If Application.CountA(Union(Cells(Target.Row, 1).Resize(, 2), Cells(Target.Row, 4))) < 3 Then Exit Sub Sheets("Registo de horas").Cells(Cells(Target.Row, 4), "AQ").Resize(, 2) = Array("Pago", Cells(Target.Row, 2)) End If End Sub deverá funcionar assim: 1. após alterar manualmente o valor em B3 o código irá limpar o intervalo A8:B506 2. após inserir manualmente valores em A, B e D, em qualquer ordem e na mesma linha, o código irá replicar os valores na planilha Registo de horas de acordo com as suas explicações no Post #20.
  10. No código existente no Post #12 consta a instrução >>> With Sheets("Registo de horas") Porém você alterou para >>> With Sheets("Consulta a um Piloto") E essa alteração tornou o código ainda mais confuso. Se entendi corretamente, o seu objetivo final é montar o histórico dos pagamentos nas colunas P:R da planilha Registo de horas. Seria esse o seu objetivo ? Em caso afirmativo, então não são necessários os dados das colunas AR:AW da planilha Registo de horas, pois é possível montar o histórico somente com os dados das colunas A, B e D da planilha Consulta a um Piloto. Dessa forma, seria mantido o seu código original que limpa as colunas A:B de Consulta a um Piloto após alterar manualmente o nome do piloto em B3, em seguida seriam preenchidos manualmente os dados nas colunas A:B e por último rodaria um outro código via botão, conforme sugerido no Post #4, com o fim de adicionar os dados de A, B e D ao histórico. Como alternativa, o segundo código (via botão) pode ser incorporado ao primeiro, e rodará após preencher manualmente A e B e se em D houver um número da linha. Se não for isso então informe o seu objetivo final com exemplos.
  11. Falta um "s" no final do termo Worksheet, deve ser Worksheets ou somente Sheets, e após corrigir, exclua o espaço em >>> ("Registo de horas")espaço.Range("
  12. Veja se lhe ajuda. Sub CopiaCola() Sheets("M FLEX").Range("A2:A" & Sheets("M FLEX").Cells(Rows.Count, 1).End(xlUp).Row).Copy _ Sheets("B DADOS").Cells(Rows.Count, 1).End(xlUp).Offset(1) End Sub
  13. 1. aplique Auto Filtro nas colunas A e B conforme os seus critérios 2. coloque em uma célula vazia o valor -1 | Copiar (Ctrl+C) 5. selecione as células visíveis com valores em C:E | Colar Especial | Multiplicação | OK Grave uma macro e coloque o código gravado aqui se precisar de ajustes.
  14. Se você quer o valor e não a fórmula, então cole o código abaixo no módulo da planilha que contém a fórmula. Private Sub Worksheet_Calculate() [GB5].NumberFormat = "@": [GB5] = [GA5] End Sub
  15. A sua fórmula retorna vazio ou texto, então basta colocar em GB5 >>> =GA5. Não precisa de mais nada.
  16. =SOMARPRODUTO(--(DIREITA(TEXTO(A10:A23;"hh:mm");1)="1")) =SOMARPRODUTO(--(DIREITA(MINUTO(A10:A23);1)="1"))
  17. Os erros ocorrem nas UDFs, visto que nelas os intervalos não referenciam a planilha de interesse, então as UDFs processam os dados da planilha ativa. Coloquei as referências na UDF modificada abaixo. Function SomaFonteRecebimento() Dim col As Long, r As Range, ws As Worksheet Set ws = Sheets("Março 2023") col = ws.Range("1:1").Find(Day(Date), , xlValues, xlPart).Column For Each r In ws.Range(ws.Cells(2, col), ws.Cells(ws.Cells(2, 1).End(4).Row, col)) If r.Font.Color <> vbBlack And Application.Caller.Offset(, -1).Value = _ ws.Cells(r.Row, 2) And "Recebimentos" = ws.Cells(r.Row, 1) Then SomaFonteRecebimento = SomaFonteRecebimento + r.Value Next r End Function Faça igual na outra UDF. Caso as UDFs forem utilizadas em outras planilhas, cujos nomes sejam diferentes de Março 2023, então utilize a instrução abaixo, assim não precisará alterar o nome da planilha nas UDFs. Set ws = Application.Caller.Parent
  18. Você quer uma macro para transferir alguns dados da planilha Check List - Peso para a primeira linha vazia da Planilha1 ? Na planilha Check List - Peso não encontrei os dados em vermelho. Informe também cada campo de Check List - Peso para qual coluna irá na Planilha1.
  19. Veja se atende. =CONCATENAR(A68;" ";TEXTO(I35;"##,00%");" ";A69;" ";TEXTO(I37;"R$ ##,00");"";A72) Na UDF, remova a sublinha na linha em que ocorre o erro. & _ "00" >>> deve ficar assim >>> & "00"

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades 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

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!