Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Numeração Sequencia...
 
Notifications
Clear all

Numeração Sequencial Automática.

 
2024 - VBA & Macros
Post Recente por teleguiado 9 anos atrás
15 Posts
3 Usuários
0 Reactions
2,436 Visualizações
RSS
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

Boa Tarde!!

Pesquisei bastante no fórum sobre o assunto e não encontrei nada parecido com o que preciso, ou se tinha alguma coisa a ver com isso o tópico estava trancado pois já tinha resolvido.
Tenho o seguinte código para numeração automática porem preciso que ele pule somente a primeira linha que ele encontrar, mesmo ela sendo numérico. :)
Segue código:

Sub numeração()

    Sheets("Plan1").Select
       Set c = Worksheets("Plan1")
       i = c.Cells(Cells.Rows.Count, "a").End(xlUp).Row
       For j = 15 To i
            If IsNumeric(c.Cells(j - 1, 1)) Then
                 c.Cells(j, 1) = c.Cells(j - 1, 1) + 1
            Else
                 c.Cells(j, 1) = 1
            End If
       Next
       
'Read more: http://excelmax.blogspot.com.br/2012/12/numeracao-automatica-no-excel-com-vba.html#ixzz43qJczMPJ
   End Sub

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 02/05/2016 1:15 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Nao entendi...

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 02/05/2016 3:05 pm
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

Acho que é isso...

Sub numeração()

    Sheets("Plan1").Select
       Set c = Worksheets("Plan1")
       i = c.Cells(Cells.Rows.Count, "a").End(xlUp).Row+1
       For j = 15 To i
            If IsNumeric(c.Cells(j - 1, 1)) Then
                 c.Cells(j, 1) = c.Cells(j - 1, 1) + 1
            Else
                 c.Cells(j, 1) = 1
            End If
       Next
       
'Read more: http://excelmax.blogspot.com.br/2012/12/numeracao-automatica-no-excel-com-vba.html#ixzz43qJczMPJ
   End Sub
 
Postado : 02/05/2016 3:10 pm
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

deu erro seu código tente isto...

Sub numeracao_automatica()
Dim ultimALINHA
If Sheets("Plan1").Range("A2") <> "" Then
ultimALINHA = Sheets("Plan1").Range("A100").End(xlUp).Row 'A 100 é referente a quantas linhas tem no seu excel
 Sheets("Plan1").Range("A" & ultimALINHA + 1).Value = Sheets("Plan1").Range("A" & ultimALINHA).Value + 1

End If
If Sheets("Plan1").Range("A2") = "" Then
Sheets("Plan1").Range("A2") = 1
End If
End Sub
 
Postado : 02/05/2016 3:26 pm
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

deu erro seu código tente isto...

Sub numeracao_automatica()
Dim ultimALINHA
If Sheets("Plan1").Range("A2") <> "" Then
ultimALINHA = Sheets("Plan1").Range("A100").End(xlUp).Row 'A 100 é referente a quantas linhas tem no seu excel
 Sheets("Plan1").Range("A" & ultimALINHA + 1).Value = Sheets("Plan1").Range("A" & ultimALINHA).Value + 1

End If
If Sheets("Plan1").Range("A2") = "" Then
Sheets("Plan1").Range("A2") = 1
End If
End Sub

Messias, o problema é que tenho várias planilhas e a quantidade de linhas varia a menor planilha tem 20 linhas porem a maior tem mais de 2000 linhas.
O código que postei funciona porem preciso que ele pule a primeira linha que ele encontra, não consegui alterar isso.

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 02/05/2016 4:11 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Se eu entendi o problema troque essa linha

ultimALINHA = Sheets("Plan1").Range("[b]A100[/b]").End(xlUp).Row 'A 100 é referente a quantas linhas tem no seu excel

Por esta

ultimALINHA = Sheets("Plan1").Range("[b]A1048576[/b]").End(xlUp).Row

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 02/05/2016 4:22 pm
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

Se eu entendi o problema troque essa linha

ultimALINHA = Sheets("Plan1").Range("[b]A100[/b]").End(xlUp).Row 'A 100 é referente a quantas linhas tem no seu excel

Por esta

ultimALINHA = Sheets("Plan1").Range("[b]A1048576[/b]").End(xlUp).Row

MPrudencio, o código é o abaixo:

Sub numeração()

    Sheets("Plan1").Select
       Set c = Worksheets("Plan1")
       i = c.Cells(Cells.Rows.Count, "a").End(xlUp).Row+1
       For j = 15 To i
            If IsNumeric(c.Cells(j - 1, 1)) Then
                 c.Cells(j, 1) = c.Cells(j - 1, 1) + 1
            Else
                 c.Cells(j, 1) = 1
            End If
       Next
       
'Read more: http://excelmax.blogspot.com.br/2012/12/numeracao-automatica-no-excel-com-vba.html#ixzz43qJczMPJ
   End Sub

Neste link http://www.tomasvasquez.com.br/forum/download/file.php?id=3164 tem um modelo da planilha que utilizo o código

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 02/05/2016 6:40 pm
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

O código que eu lhe dei por ultimo ele procura na planilha na coluna a ultima linha preenchida se não encontrar será a celula a2.

 
Postado : 02/05/2016 8:11 pm
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

Messias, pelo que entendi do seu código ele numera a partir da ultima linha preenchida o problema é que a coluna não esta vazia. Conforme imagem abaixo:

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 03/05/2016 6:26 am
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

Qual sempre será a célula que vai começar a numeração automática ?
A4 ou A5 ?

 
Postado : 04/05/2016 8:58 am
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

A5.

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 04/05/2016 11:40 am
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

Use este código sem medo de errar... que da certo.

Sub numeracao_automatica()
Dim ultimALINHA
If Sheets("Plan1").Range("A5") <> "" Then
ultimALINHA = Sheets("Plan1").Range("A60000").End(xlUp).Row 'A 100 é referente a quantas linhas tem no seu excel
Sheets("Plan1").Range("A" & ultimALINHA + 1).Value = Sheets("Plan1").Range("A" & ultimALINHA).Value + 1

End If
If Sheets("Plan1").Range("A5") = "" Then
Sheets("Plan1").Range("A5") = 1
End If
End Sub
 
Postado : 04/05/2016 1:18 pm
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

Messias, inseri o código na planilha em anexo e não funcionou.
O que pode estar errado?

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 04/05/2016 1:59 pm
 messiasmbm
(@messiasmbm)
Posts: 223
Estimable Member
 

Aqui funcionou normal...Te mandei uma mensagem privada.

 
Postado : 04/05/2016 2:52 pm
 teleguiado
(@teleguiado)
Posts: 142
Estimable Member
Topic starter
 

Segue código.

Sub VER()
Set guia = Sheets("Consolidado 2")
    Dim Consolidado_2 As Sheets
    Dim valor_pesq, coluna, temporario
    linha = 15
    coluna = 1
     Sheets("Consolidado 2").Select
     With guia
        While .Cells(linha, coluna).Value <> Empty
            valor_celula = .Cells(linha, coluna).Value 'recebe o valor da célula para fazer o teste
            
            If UCase(Left(valor_celula, Len(valor_pesq))) = UCase(valor_pesq) Then
             With Consolidado_2
              
              
              
              
              If Sheets("Consolidado 2").Cells(linha, 4) = "" Then
              temporario = 0
              End If

              If Sheets("Consolidado 2").Cells(linha, 4) <> "" Then
              If Sheets("Consolidado 2").Range("A15") <> 1 Then
              Sheets("Consolidado 2").Range("A15") = 1
              temporario = 1
              End If
              
              If Sheets("Consolidado 2").Range("A15") = 1 Then
              temporario = temporario + 1
              Sheets("Consolidado 2").Cells(linha, 1) = temporario
              End If
              End If
              
              End With
             End If
            linha = linha + 1
        Wend
        End With
End Sub

Obrigado.

Teleguiado.
E-mail: [email protected]

 
Postado : 13/05/2016 8:52 am
Forum Jump:
  Tópico Anterior
Próximo Tópico