Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Sequência de número...
 
Notifications
Clear all

[Resolvido] Sequência de números dentro de cada bloco

 
2024 - VBA & Macros
Post Recente por vonzuben 4 anos atrás
5 Posts
2 Usuários
1 Reactions
1,259 Visualizações
RSS
 vonzuben
(@vonzuben)
Posts: 549
Honorable Member
Topic starter
 

Estou tentando fazer uma sequência de números 1,2,3,4.... dentro de cada bloco.
Consigo fazer quando a célula é fixa, mas dinâmico está dando erro.

Botão na parte verde cria um bloco, pois até aqui tudo bem.
Clicando nos 3 pontinhos ( Linha azul; do lado esrito Bloco), cria-se linha para o bloco.
O problema que a númeração está indo 1,2,2,2.... e não 1,2,3,4...

OBS: Para cada bloco será essa sequência 1,2,3,4...

Problema ocorre nessa linha : Range(Cells(Linha + 1, 5)).FormulaR1C1 = "=LIN()"

Obrigado desde já !

Este tópico foi modificado 4 anos atrás 2 vezes by vonzuben
 
Postado : 17/02/2021 11:22 am
EdsonBR
 EdsonBR
(@edsonbr)
Posts: 1057
Noble Member
 

Bom dia, @vonzuben

Copie e cole o código abaixo no módulo de eventos da planilha, junto com o Worksheet_Change:

Private Sub RenumerarBloco(rgBloco As Range)
  Dim i As Long
  With Range(rgBloco, rgBloco.End(xlDown))
    With .ColumnDifferences(Comparison:=.Find(What:=1, LookAt:=xlWhole)).Areas(1)
      For i = 1 To .Cells.Count
        .Cells(i).Value = i + 1
      Next i
    End With
  End With
End Sub

Faça a chamada dentro do bloco IF que já existe no Worksheet_Change:

Private Sub Worksheet_Change(ByVal Target As Range)
   ...
   ...
   ...
   If Range("J" & Linha) = "INSERIR" Then
       ...
       ...
       Range("J" & Linha).Value = "• • •"
       Call RenumerarBloco(Range("E" & Linha))  '***********

   End If
   ...
   ...
End Sub

 

 
Postado : 18/02/2021 8:42 am
vonzuben reacted
 vonzuben
(@vonzuben)
Posts: 549
Honorable Member
Topic starter
 

Não funcionou !

 
Postado : 18/02/2021 11:46 am
EdsonBR
 EdsonBR
(@edsonbr)
Posts: 1057
Noble Member
 

?????

 
Postado : 18/02/2021 12:09 pm
 vonzuben
(@vonzuben)
Posts: 549
Honorable Member
Topic starter
 

Acabei esquecendo de colocar a linha abaixo rs
wsAtiva.Range(Cells(1, 5), Cells(1, 11)).Copy: wsAtiva.Range(Cells(Linha + 1, 5), Cells(Linha + 1, 11)).Insert shift:=xlDown

Motivo : Copie o seu e colei ( nem prestei atenção que faltava essa linha )

 
Postado : 18/02/2021 2:43 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico