Este fórum está sendo desativado

[Mauro]

Boa tarde,

Preciso que ao colorir uma célula, a célula da coluna imediatamente ao lado é preenchida com o valor =Maior(Range) + 1.

Ou seja, se eu colorir a célula A5 então o Excel verifica qual o numero maior no range B:B suponhamos que seja 15 então ele preenche a célula B5 com o valor 16.

Obrigado

[osvaldomp]

Aplicar cor em uma célula não dispara qualquer evento, então em seguida será necessário efetuar manualmente alguma operação que possa disparar algum evento, como apertar Enter ou clicar com o direito ou aplicar duplo clique.
Se você quiser testar, segue uma solução que utiliza Enter. Instale uma cópia dos dois primeiros códigos abaixo no módulo da planilha de interesse e uma cópia do terceiro código em um módulo comum.

Código: Selecionar todos

Private Sub Worksheet_Activate()
 Application.OnKey "{ENTER}", "InsereMáx"
End Sub

Código: Selecionar todos

Private Sub Worksheet_Deactivate()
 Application.OnKey "{ENTER}"
End Sub

Código: Selecionar todos

Sub InsereMáx()
 If ActiveCell.Column = 1 And ActiveCell.Interior.ColorIndex <> -4142 Then _
  ActiveCell.Offset(, 1).Value = Application.Max([B:B]) + 1
End Sub

#
funcionamento - após aplicar cor em uma célula da coluna A aperte a tecla Enter localizada junto ao teclado numérico, assim o terceiro código irá inserir em B, mesma linha, o máximo valor de B acrescido de uma unidade.

[Mauro]

Muito obrigado. É exatamente isto que procuro. Seria possível fixar o pincel de formatação numa cor qualquer e utilizar o invento de clicar para pintar a coluna A e ao mesmo tempo numerar a coluna B?

[osvaldomp]

Instale uma cópia do código abaixo no módulo da planilha.
Esta solução não necessita dos códigos que passei antes.

Código: Selecionar todos

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Target.Column > 1 Then Exit Sub
 Target.Interior.Color = vbYellow
 Target.Offset(, 1).Value = Application.Max([B:B]) + 1
 Cancel = True
End Sub

#
funcionamento - ao aplicar duplo clique em qualquer célula da coluna A o código irá pintar a célula clicada de amarelo e irá inserir em B, mesma linha, o máximo valor de B acrescido de uma unidade.

[Mauro]

Boa noite, funciona perfeitamente, agradeço a sua ajuda.
Estou a tentar implementar o evento do duplo clique e a função Application.OnKey simultaneamente. Fiz algumas alterações da função "InsereMáx", segue abaixo o codigo.

Código: Selecionar todos

Dim rang As Range
Sub InsereMáx()
Set rang = Selection
If rang.Column > 1 Then Exit Sub
If rang.Offset(, 1).Value > 1 Then
 MsgBox ("Ja esta(o) numerada(s)")
 Exit Sub
End If
rang.Interior.Color = vbYellow
 rang.Offset(, 1).Value = Application.Max([B:B]) + 1
End Sub

Desta forma consigo fazer uma seleção, pintar essa mesma seleção, numerar as células do range B:B e se alguma estiver numerada ele para.
O problema é a minha 2ª condição.

Código: Selecionar todos

If rang.Offset(, 1).Value > 1 Then
 MsgBox ("Ja esta(o) numerada(s)")
 Exit Sub
End If

Se eu selecionar as células com a tecla "Ctrl" ex: "A1;A9;A3" a condição funciona perfeitamente, se alguma célula da seleção em B:B estiver preenchida, ele para o procedimento, perfeito! Mas se eu selecionar com um range com 1 rato ex. "A3:A5" dá erro.
Alguma dica?
Obg e cmps

[osvaldomp]

Uma possibilidade é aplicar as ações do código individualmente em cada célula selecionada, via Loop.

Assim, em lugar de Set rang = Selection coloque

For each rng in Selection
'seu código
Next rng

Se você não conseguir então disponibilize uma amostra do seu arquivo Excel com TODOS os códigos instalados e descreva com exatidão o que deseja fazer.

[Mauro]

Boas, com o loop ele numera sequencialmente a seleção, ou seja, eu seleciono A5:A7 e ele numera A5=1; A6=2, A7= 3 mas o pretendido é ele numerar a seleção com o mesmo numero. A5, A6, A7 = 1
Apenas quando eu voltar a selecionar novamente, aí é que ele vai numerar com um novo numero.
O meu objetivo é picar os valores de um extrato e numerar sequencialmente mas às vezes vou numerar vários valores e esses valores têm que ter a mesma numeração.
Criei também procedimentos que não estão a funcionar a 100%, em que se eu eliminar algum numero ele renumera todos os outro e se eu me esquecer de picar algum valor que deveria estar numa certa posição através da numeração, então eu atribuo a numeração manualmente e o procedimento renomera o restante. Não sei se fui explicito o suficiente. Deixo em anexo tudo o que consegui até ao momento. Obrigado

[osvaldomp]

Experimente o código abaixo no lugar do existente.

Código: Selecionar todos

Sub InsereMáx()
 Dim rng As Range, n As Boolean
  For Each rng In Selection
   If rng.Column = 1 Then
    If rng.Offset(, 1) <> "" Then
     MsgBox rng.Offset(, 1).Address(0, 0) & " ja está numerada"
    ElseIf Not n Then
     rng.Offset(, 1).Value = Application.Max([B:B]) + 1
     rng.Interior.Color = vbYellow
     n = True
    Else: rng.Offset(, 1).Value = Application.Max([B:B])
     rng.Interior.Color = vbYellow
    End If
   End If
  Next rng
End Sub

#

[Mauro]

Boa tarde Osvaldo, está muito bom o código mas tem um senão que pode induzir em erro quem está a trabalhar no ficheiro, passo a explicar. Eu seleciono um grupo de células ex: A3:A9 em que a célula A3 e A5 estão numeradas mas as restantes não, ele efetivamente menciona na msgbox quais as células que estão numeradas e não faz nada(5*) mas numera as restantes, o que é um problema porque quem está a trabalhar pode não se aperceber e está o caldo entornado . Tentei para o loop com um exit for aseguir a msgbox mas ele efetua sempre a numeração da primeira seleção se não tiver numerada.
cmps

[osvaldomp]

... mas numera as restantes, o que é um problema ...
E o que você quer fazer nesses casos?

Com base nos critérios que você colocou antes, no caso de seleção multi células, adjacentes ou não, o código irá analisar cada uma da seleção, nada fará se em B já houver conteúdo, e nas demais colocará em B o máximo+1 e repetirá esse valor nas outras e pintará A.

O quer você quer alterar nesses critérios ?

[Mauro]

Boas,
Por exemplo, se da seleção A1:A9 algum B estiver preenchido então não preencher nenhum.

[osvaldomp]

Veja se atende.

Código: Selecionar todos

Sub InsereMáx()
 Dim rng As Range, n As Boolean, c As Range
  Set c = Selection.Offset(, 1)
  If Application.CountA(c) > 0 Then
   MsgBox "Há pelo menos uma célula numerada em B" & vbLf _
    & "           o código será encerrado"
   Exit Sub
  End If
   For Each rng In Selection
    If rng.Column = 1 Then
     If Not n Then
      rng.Offset(, 1).Value = Application.Max([B:B]) + 1
      rng.Interior.Color = vbYellow
      n = True
     Else: rng.Offset(, 1).Value = Application.Max([B:B])
      rng.Interior.Color = vbYellow
     End If
    End If
   Next rng
End Sub

[Mauro]

Perfeito! Obrigado.

[Mauro]

Bom tarde, ainda em relação a este assunto, uma ultima questão, fazer a seleção através de células escondidas por filtro?
Eu estou a começar com a programação, eu consegui entende praticamente todos os códigos que me enviou, deixo código comentado:

Código: Selecionar todos

Sub NumerarExt()
    Dim rng         As Range, tRng As Range, n As Boolean, c As Range
    Set tRng = Selection
    'Se a(s) celula(s) selecionada(s) estiver(em) na coluna 4
    If tRng.Column = 4 Then
        'Verifica se existe alguma celula preenchida da seleção tRng na coluna 5 (Offset(, 2)) se _
        houver ele apresenta msgbox
        Set c = Selection.Offset(, 2)
        If Application.CountA(c) > 0 Then
            MsgBox "Há pelo menos um valor ja numerado!"
            Exit Sub
        End If
        'Se não, se a(s) celula(s) selecionada(s) estiver(em) na coluna 5
    ElseIf tRng.Column = 5 Then
        Set c = Selection.Offset(, 1)
        'Verifica se existe alguma célula preenchida da seleção tRng na coluna 5 (Offset(, 2)) se _
        houver ele apresenta msgbox
        If Application.CountA(c) > 0 Then
            MsgBox "Há pelo menos um valor ja numerado!"
            Exit Sub
        End If
    End If
    'Por cada seleção
    For Each rng In Selection
        'Se a seleção for na columa 4
        If rng.Column = 4 Then
            'Se for selecionado como Ex: "D4:D:6" ou Ex: "D4;D5;D6" vai _
            somar o maior valor + 1(Application.Max([F:F]) + 1) ao(s) valore(s) da seleção paralela(coluna 5)
            If Not n Then
                rng.Offset(, 2).Value = Application.Max([F:F]) + 1
                rng.Interior.Color = vbYellow
                n = True
            Else: rng.Offset(, 2).Value = Application.Max([F:F])
                rng.Interior.Color = vbYellow
            End If
        End If
        'Se a seleção for na columa 5
        If rng.Column = 5 Then
            'Se for selecionado como Ex: "E4:E:6" ou Ex: "E4;E5;E6" vai _
            somar o maior valor + 1(Application.Max([F:F]) + 1) ao(s) valore(s) da seleção paralela(coluna 5)
            If Not n Then
                rng.Offset(, 1).Value = Application.Max([F:F]) + 1
                rng.Interior.Color = vbYellow
                n = True
            Else: rng.Offset(, 1).Value = Application.Max([F:F])
                rng.Interior.Color = vbYellow
            End If
        End If
    Next rng
End Sub

só não consegui perceber o funcionamento desta parte relativamente ao IF

Código: Selecionar todos

If Not n Then
                rng.Offset(, 1).Value = Application.Max([F:F]) + 1
                rng.Interior.Color = vbYellow
                n = True
            Else: rng.Offset(, 1).Value = Application.Max([F:F])
                rng.Interior.Color = vbYellow
            End If

O quê que ele está validar como falso ou verdadeiro? Será que me pode dar uma breve explicação? Obrigado

[osvaldomp]

O quê que ele está validar como falso ou verdadeiro?

A variável n está declarada como tipo Boolean, então ela assumirá o valor Verdadeiro ou o valor Falso.
Por padrão, a cada vez que o código for executado essa variável será inicializada com o valor Falso.

No caso da seleção de múltiplas células o critério que você estipulou foi que a primeira célula receberia máximo+1 e as demais receberiam valor igual à primeira.
Aproveitei essa característica da variável para determinar ao código quando inserir máximo+1 e quando inserir somente máximo.

Então ao rodar o código, ao analisar a primeira célula, o valor de n será Falso por padrão, e nesse caso o comparativo If Not n retornará afirmativo e aí a célula à direita receberá o valor máximo+1, e na sequência o código altera o valor de n para Verdadeiro, preparando assim a variável para a análise da segunda célula da seleção.

Ao analisar as demais células da seleção a partir da segunda, o comparativo If Not n retornará negativo e então será executada a alternativa Else que irá inserir o máximo e não mais o máximo+1.

dica - a condição If Not n equivale a If n=False e também a If n <> True

[Mauro]

Entendi, perfeito, obrigado.