Excel Excel - Tenho o endereço de uma célula como colocar um valor nele

[Angelo Campos]

Tenho o endereço calculado de uma célula como coloco um valor diretamente nessa célula?

Exemplo:

Na célula $AW$25 tenho o endereço $S$375, obtido com a função ENDEREÇO como coloco ocupado nessa célula?

[Wendell Menezes]

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.

[Angelo Campos]

Primeiro que tudo um agradecimento pela solução feita.

 

Um esclarecimento.

Este pedido é para eu saber como colocar, mas afinal a solução que pedi não é a mais aconselhável.
Assim, onde pretendia colocar este pedido o mais aconselhável é um loop em VB.
Assim é o seguinte:

Eu tenho em Excel um ficheiro de registo de voos, depois noutra folha do mesmo ficheiro tenho todos os voos feitos por um Piloto.
Nas colunas A e B eu coloco na(s) linha(s) referentes a um voo que pagaram a palavra Pago e a Data as outras linhas ficam em branco.
Toda a vez que selecionar outro Piloto as colunas A e B são limpas via VB.
No folha registo de horas tenho na célula AS8 o número de voos efetuados pelo Piloto, pois pode ser só um ou dois.
Assim julgo que o ideal será um loop em Visual Basic em que analisa se a coluna AT tem a palavra Pago se o tiver coloca Pago na coluna Q da linha correspondente à (coluna AS) e a data da coluna AU na coluna AR).
Faz o loop até ao valor inscrito na célula AS6.
 

Registo de horas VB.xlsx

[Wendell Menezes]

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

 

[Angelo Campos]

14 minutos atrás, Wendell Menezes disse:

 

Está quase.
Como coloquei à condição nas colunas AV e AW os endereços das células onde coloco Pago e a data se for caso disso, copiei o VB que fez e alterei-o. Fiz bem?

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("AV" & r)) = "Pago"

                   .Range("AU" & .Range("AS" & r)) = .Range("AU" & r) End If Next End With End Sub

 

[Wendell Menezes]

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?

 

 

[Angelo Campos]

Alterei para ficar assim

Private 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 ("AV" & r = "Pago"
                .Range ("AW" & r = .Range("AU" & r)
            End If
        Next
    End With
End Sub

Porquê?
É que para facilitar coloquei nas colunas AV o número da linha de Pago e em AW o número da linha onde tenho a data.
Não funciona.
Onde está o erro?
 

Bem. Tenho de ir dormir porque aqui já são 1H15 e respondi-lhe noutra janela e não acaba e assim não posso ler a sua resposta.

[Angelo Campos]

Está descoberta a razão porque não funcionou.

Coloquei a sua versão e mesmo assim não funciona.
Não será necessário fazer alguma operação para reconhecer esta programação em VB?

 

[Angelo Campos]

Tenho estado a tentar e não consigo.
Pode enviar-me o ficheiro em Excel que usou com o VB mas com os VB que já cá tenho a ver se eu o posso usar com os meus dados reais?
Eu no meu ficheiro já tenho VB e funciona.

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

 

Este tenho-o mas coloquei células sem interesse porque posso ter necessidade de o usar.

 

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

Está tudo certo náo está.

 

Private 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

 

[Wendell Menezes]

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)?

[Angelo Campos]

Tem de ser automático como tenho a recolha das colunas A e B de Consulta a um Piloto que coloca o que está nas colunas A e B e coloca nas colunas AS, AT e AU na folha Registo de horas.

É só isso, então posso emendar aqui desde que me diga como fazer ou emendar e eu copiar.
Como aqui já é meia noite tenho de ir dormir.

 

[Wendell Menezes]

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.

 

[Angelo Campos]

Não estou a conseguir vincular o VB que fez porque não sei fazer (vincular) mesmo com a sua explicação.
Pode-me enviar o ficheiro em que criou e testou?

[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.

[Angelo Campos]

Já está.
Muitíssimo obrigado.

[Angelo Campos]

Ainda o Visual Basic.
Ontem ao reparar melhor para o que me fez em Visual Basic pensei que, para quem sabe, seria possível para colocar Pago e a Data nas colunas Q e R e fazer a análise se aquele voo tem Pago e a Data em Consulta a um Piloto, colunas A e B e a linha que está na coluna D.
Assim deixava de copiar as 500 linhas das colunas A e B para as colunas AS, AT e AU da folha Registo de horas.
Assim era assim

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("Consulta a um Piloto")
                    For r = 8 To .Range("AL3")
                        If .Range("A" & r) = "Pago" Then
                            Worksheet ("Registo de horas") .Range("Q" & .Range("D" & r)) = "Pago"
                            Worksheet ("Registo de horas") .Range("R" & .Range("D" & r)) = .Range("B" & r)
                        End If
                    Next
                End With
            End If
        Next
    End If
End Sub

Mas não funciona. As linhas começadas por Worksheet ficam a vermelho.

É mesmo possível?

[OreiaG]

Em 01/05/2023 às 19:44, Angelo Campos disse:

As linhas começadas por Worksheet ficam a vermelho.

 

 

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("

[Angelo Campos]

Obrigado.
Agora tenho mais este problema
 .Range("Registo de horas!Q" & .Range("D" & r)).Value = "Pago"

O que está errado na escrita desta linha de código?
O que pretendo é colocar na linha que tenho na folha Consulta a um Piloto (D) na folha Registo de horas na coluna Q a palavra Pago.

.Range("Registo de horas!R" & .Range("D" & r)).Value = .Range("B" & r) e aqui na R a data do Pagamento.

 

Onde é que tenho o erro?

      O que tenho em VB

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("Consulta a um Piloto")
                    For r = 8 To .Range("AL3")
                        If .Range("A" & r) = "Pago" Then
                            .Range("Registo de horas!Q" & .Range("D" & r)).Value = "Pago"
                            .Range("Registo de horas!R" & .Range("D" & r)).Value = .Range("B" & r)
                        End If
                    Next
                End With
            End If
        Next
    End If
End Sub                

 

[OreiaG]

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.

[Angelo Campos]

O que pretendo é fazer tudo sem botão.
Assim por exemplo:
Coloco na célula A7 Pago  e na B7 a data do Pagamento 07/05/2021 e a linha D7 tem o número da linha na folha Registo de horas, por exemplo 1255.
Ao fazer a iteração encontro Pago e assim em VB faço uma linha de código que me execute o seguinte:
Registo de horas!AQ1255 Pago

Registo de horas!AR1255 07/05/2021
Eu fiz as seguintes linhas de código:
.Range("Registo de horas!Q" & .Range("D" & r)).Value = "Pago"  .Range("Registo de horas!R" & .Range("D" & r)).Value = .Range("B" & r)

Onde tenho o erro?
Julgo que é aqui que está o erro.

 

[OreiaG]

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.

[Angelo Campos]

Tenho estado a analisar o que me enviou mas ainda não consegui.
Como aqui já é tarde amanhã continuo:
O que me faz espécie é a referência à célula AQ que não uso.

[OreiaG]

 

13 minutos atrás, Angelo Campos disse:

O que me faz espécie é a referência à célula AQ que não uso.

AQ e AR foram indicações suas no Post #20, reproduzidas abaixo.

 

8 horas atrás, Angelo Campos disse:

Ao fazer a iteração encontro Pago e assim em VB faço uma linha de código que me execute o seguinte:
Registo de horas!AQ1255 Pago

Registo de horas!AR1255 07/05/2021

 

 

[Angelo Campos]

Primeiro que tudo as minhas desculpas por escrever que eram as células AQ e AR quando eram as células Q e R.
Envio um ficheiro em Excel para poder testar, mas sem o seu Visual Basic porque para meu espanto não aceita ficheiros em Excel com a extensão .xlsm.

Citação

Citação

 

 

 

Registo de horas teste.xlsx

[OreiaG]

1 hora atrás, Angelo Campos disse:

Primeiro que tudo as minhas desculpas por escrever que eram as células AQ e AR quando eram as células Q e R.

No código do Post #21 remova o "A" de "AQ" .

Deverá ficar assim >>> "Q".

 

... porque para meu espanto não aceita ficheiros em Excel com a extensão .xlsm.

Arquivos com macros precisam ser compactados para anexar. Veja os compactadores permitidos em Tipo de arquivos permitidos no rodapé da caixa Responder.