Wendell Menezes

Oi amigo, não consigo, ficarei 3 semanas konge do meu PC . Clique com o botão direito no nome da sheet e depois em Exibir Codigo. Apague tudo o que tiver e coloque apenas o meu codigo e teste.

Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range Dim r As Integer If Target.Address(False, False) = "B3" Then Range("A8:B506").ClearContents Else For Each Cell In Target If Cell.Row >= 8 And Cell.Column <= 2 Then With Sheets("Registo de horas") For r = 8 To .Range("AS6") If .Range("AT" & r) = "Pago" Then .Range("Q" & .Range("AS" & r)) = "Pago" .Range("R" & .Range("AS" & r)) = .Range("AU" & r) End If Next End With End If Next End If End Sub Cole o código acima no módulo da sheet "Consulta a um Piloto" As colunas "AV" e "AW" da sheet "Registo de horas" não são necessárias.

=SE(ÉERROS(PROCV(A2;C:C;1;0));"Não";"Sim")

Boa tarde, Segue planilha com exemplo, seria isso? Meu Excel está em inglês, então talvez seja necessário alterar o formato da data para mmmm/aaa no seu computador. Book1.xlsx

Oi Angelo, Só para confirmar, você entende que o meu código é uma SUB comum que você deve adicionar à algum botão ou pressionar F5 com curso dentro do código para executar ele e ver o resultado? Fiquei com essa dúvida porque o seu exemplo abaixo é uma SUB vinculada ao evento de alteração da planilha. Ou seja, o VBA ativa a macro automaticamente quando você altera o valor de qualquer célula. Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3")) Is Nothing Then Range("A7:A506").ClearContents Range("B7:B506").ClearContents End If End Sub Você quer que o LOOP seja feito quando? Quando você ativá-lo manualmente (como eu pensei que era) ou quando você alterar alguma célula / coluna em particular (de forma automática)?

O excel parece não aceitar essa combinação, mas você pode fazer isso de forma indireta. =UNICO(Y) na célula A1 Depois em B1, =ORDEM.EQ(X;A1#;0)

Oi Angelo, Na minha versão o loop encontra "Pago" na célula AT9 e escreve "Pago" na célula Q1175. A sua versão encontra o mesmo "Pago" na célula AT9 e escreve "Pago" na célula AV9. Qual é o correto?

Não sei se entendi bem, veja se seria algo assim; Sub LOOP_ANGELO() Dim r As Integer With Sheets("Registo de horas") For r = 8 To .Range("AS6") If .Range("AT" & r) = "Pago" Then .Range("Q" & .Range("AS" & r)) = "Pago" .Range("R" & .Range("AS" & r)) = .Range("AU" & r) End If Next End With End Sub

Experimente essa versão: Private Sub Worksheet_Change(ByVal Target As Range) 'Por Wendell Dim Cell As Range For Each Cell In Target With Cell If .Column = 12 Then 'Coluna "L" Range("AY" & .Row).NumberFormat = "@" 'AY é Coluna VBA Range("AY" & .Row) = Range("AX" & .Row) 'AX é Coluna Fórmulas End If End With Next End Sub

Clique com o botão direito no nome da aba -> Exibir Código e cole: Private Sub Worksheet_Calculate() On Error Resume Next Range(Range("AW25")) = "Ocupado" End Sub A macro será ativada toda vez que o Excel cálcular o resultado das fórmulas e irá colocar "Ocupado" no endereço da célula que estiver escrita em AW25.

Bom dia, Veja se seria isso: Gastos mes ajuda.zip

Presumindo que a linha com o SUBTOTAL não exista e tenha que ser criada: Sub SUBTOTAL() Dim r As Long Dim h As Byte r = 14 While Cells(r, 1) <> "" h = 1 While Cells(r, 4) = Cells(r + h, 4) h = h + 1 Wend Cells(r + h, 4).EntireRow.Insert Cells(r + h, 2) = "**SUBTOTAL" Cells(r + h, 9).Formula = "=SUBTOTAL(9,I" & r & ":I" & r + h - 1 & ")" If IsNumeric(Cells(r, 11).End(xlUp)) Then Cells(r + h, 11).Formula = "=K" & Cells(r + 1, 11).End(xlUp).Row & "-I" & r + h Else Cells(r + h, 11).Formula = "=I" & r + 1 End If r = r + h + 1 Wend End Sub

Isso seria mais parecido com o que estava tentar fazer: Sub EnterCell() Dim Cell As Range For Each Cell In Plan1.Range("FO1:FZ5000") Cell.Select Cell.Value = Cell.Value Next End Sub

Assim? Sub COLAR_VALORES() Plan1.Range("FO5:FZ5000").Value = Plan1.Range("FO5:FZ5000").Value End Sub

Boa tarde, Não sei se entendi bem, A LR verifica qual é a últinha linha da planilha para então testar em cada uma delas se atende a condição necessária para converter para negativo. Se retornasse um número menor (ex: apenas a quantidade de linhas com "Cod2" ela não iria terminar de converter até o final e o código iria parar antes da hora.

Seria isso? Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range For Each Cell In Target With Cell If .Column >= 171 And .Column <= 182 Then 'FO - FZ Range("GB" & .Row).NumberFormat = "@" Range("GB" & .Row) = Range("GA" & .Row) End If End With Next End Sub

@Zamboni_du Sub NEGATIVE() Dim RefDate As Long Dim LR As Long Dim r As Long RefDate = Range("J2") LR = Cells(Rows.Count, 1).End(xlUp).Row For r = 2 To LR If Cells(r, "A") = RefDate And Cells(r, "B") = "Cod2" Then If Cells(r, "C") > 0 Then Cells(r, "C") = Cells(r, "C") * -1 If Cells(r, "D") > 0 Then Cells(r, "D") = Cells(r, "D") * -1 If Cells(r, "E") > 0 Then Cells(r, "E") = Cells(r, "E") * -1 End If Next End Sub

Boa tarde, Dê uma olhada no tópico abaixo, não conheço um jeito "limpo" de fazer algo assim. Utilzei tabela dinâmica para lidar com as duplicatas e saber o tamanho (quantidade de itens) de cada lista para então usar DESLOC na validação de dados. https://www.clubedohardware.com.br/forums/topic/1640183-validação-de-dados-dois-critério/

Boa tarde, E como você quer que isso seja feito? Fórmula? VBA? Pode postar uma planilha com dados de modelo e os resultados esperados?

Independente de ser ComboBox ou ListView, é possível adicionar novos items a partir de células que são resultados de fórmulas, por isso acredito que o problema seja o código que você está utilizando para inserir novos items. Veja um exemplo que funciona mesmo com fórmulas nas células A1 e A2:

Eu confesso que não entendi porque o Dropdown não está sendo carregado pelo fato do ano ser resultado de uma fórmula. Qual é o código que você está usando para carregar ele? Veja esse exemplo, A1 é uma fórmula: O código que carrega ele é: Private Sub ComboBox1_DropButtonClick() ComboBox1.Clear ComboBox1.AddItem Range("A2").Value End Sub

Clique com o botão direito do mouse no nome da aba (ex: Plan1), depois exibir código. Cole o script abaixo e feche a janela. Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range For Each Cell In Target With Cell If .Column = 183 Then 'Número da coluna GA Range("GB" & .Row).NumberFormat = "@" Range("GB" & .Row) = Range("GA" & .Row) End If End With Next End Sub Toda vez que alterar alguma coisa na coluna GA (ex: arrastando / inserindo fórmulas) o valor dela será colado como texto na coluna GB. Agora se quiser que isso funcione APENAS na célula GA5: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) = "GA5" Then [GB5].NumberFormat = "@": [GB5] = [GA5] End If End Sub

entendi, como última alternativa eu tentaria ativar a referência do Outlook e alterar o código para: Dim OutApp as Outlook.Application Set OutApp = New Outlook.Application

Boa tarde, Não consigo testar o código porque não tenho Outlook nesse PC, mas experimente trocar a linha 12 por Set OutApp = GetObject(, "Outlook.Application")

Bom dia, Ficaria assim (alterar o valor da variável folder para a pasta onde estão os arquivos Excel a serem lidos): Sub GET_SHEET_NAMES() Dim FSO As Object Dim Folder As String Dim File As Object Dim wb As Workbook Dim ws As Worksheet Dim LR As Long Set FSO = VBA.CreateObject("Scripting.FileSystemObject") Folder = "C:\Users\PC\Desktop" Application.DisplayAlerts = False For Each File In FSO.GetFolder(Folder).Files If InStr(1, LCase(File), ".xls") > 0 And InStr(1, LCase(File), "$") = 0 And File.Name <> ThisWorkbook.Name Then Set wb = Workbooks.Open(File, UpdateLinks:=False) With ThisWorkbook.ActiveSheet LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For Each ws In wb.Worksheets .Cells(LR, 1) = wb.Name .Cells(LR, .Cells(LR, Columns.Count).End(xlToLeft).Column + 1) = ws.Name Next End With wb.Close False End If Next End Sub