Macro que cola um X em células de uma coluna

Boas pessoal,

Preciso da vossa ajuda.
Tenho 2 problemas que precisava da ajuda de alguem que perceba de programação de macro / VBA

Primeiro problema
Tenho uma macro com função double click, que cola um X nas celulas de numa determinada Coluna (A), mas eu queria que voltando a clicar na mesma célula a macro apague esse mesmo X

Exemplo, cliquei na celula (A3) mas afinal não era aquela celula era outra, (A4), então voltava a clicar na celula (A3) e eliminava o X.

O segundo problema
Ainda dentro desta macro,  eu queria colar o X na coluna A mas  na realidade eu queria clicar na célula da coluna B para automaticamente colar o X na célula da coluna A

Exemplo

..|......A.......|.......B......|......C......|
..|...............|Nº Cliente|   Nome
1|......X.......|...25235...|...Jose......|
2|...............|...25340...|...Carlos...|
3|...............|...25458...|...Maria....|


Ao clicar na B1 a macro colava o X na celula A1 e assim sucesivamente, clicar na B2, cola X na A2 e por ai a diante

Esta é a macro que eu encontrei que cola o X nas celulas da coluna A

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rInt As Range
   Dim rCell As Range

   Set rInt = Intersect(Target, Range("a2:a1000"))
   If Not rInt Is Nothing Then
       For Each rCell In rInt
           rCell.Value = "X"
       Next
   End If

   Set rInt = Nothing
   Set rCell = Nothing
   Cancel = True

End Sub


Espero que alguem me consiga ajudar com uma nova macro que consiga fazer estas coisas. Eu sou um nabo em programação

Obrigado antecipadamente pela ajuda
Cumprimentos
RP

Boa tarde!!

Você postou essa mesma dúvida em outro fórum?


Att

Boa tarde!!

Você postou essa mesma dúvida em outro fórum?


Att

Não, eu não postei em outros fóruns, foi só neste e foi um único post.
Porque é que você diz isso?

Boa tarde!!

Uma parte do que pediu seria isso?

Código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rInt As Range
  Dim rCell As Range

  Set rInt = Intersect(Target, Range("a2:a1000"))
  If Not rInt Is Nothing Then
      For Each rCell In rInt
      If rCell.Value = "X" Then
          rCell.Value = ""
          Else
          rCell.Value = "X"
      End If
      Next
  End If

  Set rInt = Nothing
  Set rCell = Nothing
  Cancel = True

End Sub

Att

Sim Alexandre, essa é uma parte do codigo que pedi ajuda, e pelo que eu vejo era bem simples.

O problema agora é a segunda parte da minha questão, que me parece mais complicado.

Mas muito obrigado por me responder. Será que você me consegue ajudar a resolver o segundo problema interligando esta macro com a situação explicada no segundo problema?

alexandrevba escreveu:

Boa tarde!!

Uma parte do que pediu seria isso?

Código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rInt As Range
   Dim rCell As Range

   Set rInt = Intersect(Target, Range("a2:a1000"))
   If Not rInt Is Nothing Then
       For Each rCell In rInt
       If rCell.Value = "X" Then
          rCell.Value = ""
          Else
           rCell.Value = "X"
       End If
       Next
   End If

   Set rInt = Nothing
   Set rCell = Nothing
   Cancel = True

End Sub

Att

Boa tarde!!

Vejamos se eu entendi...
Faça os testes.

Código:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim rInt As Range
  Dim rCell As Range

  Set rInt = Intersect(Target, Range("B2:B1000"))
  If Not rInt Is Nothing Then
      For Each rCell In rInt
      If rCell.Offset(, -1).Value = "X" Then
          rCell.Offset(, -1).Value = ""
          Else
          rCell.Offset(, -1).Value = "X"
      End If
      Next
  End If

  Set rInt = Nothing
  Set rCell = Nothing
  Cancel = True

End Sub

Att