Preecher com numero a parti de um campo

Question

Como posso fazer para o Excel preecher a coluna B assim que ela indentifica que tenho informaçoes na coluna C.

Exemplo: A minha coluna B esta inteira limpa, assim que eu rodar um comando em VBA ele vai ler a coluna C. Assim que ele econtra os campos que estao marcados em amarelo ou a opçao saldo anterior ele preenchera a coluna B sempre na frente da data com um numero sequencial como esta marcado em verde.

Assim que ele mudar para o proximo fornecedor ele colocar o proximo numero, entao um fornecedor que tenha 20 linhas ele carregara o numero 1, assim o proximo fornecedor se ele tiver 100 linhas carregara o numero 2

Esse exemplo foi feito a mao, entao no primeiro fornecedor (ABC Contrapinos) ele preencheu com numero 1 na frente da data, assim que terminou começou o outro fornecedor (Cestari) entao ele preencheu com numero 2. Isso fiz na mao como faria para fazer isso em uma planilha que sempre tem em torno de 17.000,00 linhas com comando VBA.

se precisar do link para a planilha ai esta: http://www.sendspace.com/file/25k3r1

Answer 1

Sub Exemplo()
    Dim lRow As Long
    Dim lSeq As Long
    
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    With ws
        lRow = 1
        Do
            Do While .Cells(lRow, "A") <> ""
                .Cells(lRow, "B") = lSeq
                lRow = lRow + 1
            Loop
            lRow = lRow + 1
            If .Cells(lRow, "A") <> "" Then lSeq = lSeq + 1
        Loop While .Cells(lRow, "A").End(xlDown).Row < .Rows.Count
    End With
    
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Amigo... 8)

Seguinte... Roda esse codigo ele ta configurado de acordo com a planilha que voce anexou no Link... mesmo que voce nao va utilizar a sua planilha formatada por esse codigo.... dá uma olhada... pra ter valido o trabalho... kkkk

Private Sub FormataTabela_Click()
    ' -= declaracao das variaveis =-
    Dim i As Integer
    Dim Cont As Integer
    Dim ContItens As Integer
    Dim Indice As Integer
    Dim Coluna1Origem As Integer ' 1ª coluna da 1ª Planilha
    Dim Coluna1Destino As Integer ' 1ª coluna da 2ª Planilha
    
    ' cria uma tabela onde serao armazenados os registros organizados
    ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=1
    
    ' define a coluna inicial de Origem
    Coluna1Origem = 1
    ' define a coluna inicial de Destino
    Coluna1Destino = 1
    
    ' cria um objeto da tabela Razão
    Set wsPlanOrigem = Worksheets("Razão")
    ' cria um objeto da tabela criada
    Set wsPlanDestino = Worksheets(ActiveSheet.Name)
    
    ' ativa a tabela de origem
    wsPlanOrigem.Activate
    
    ' total de linhas na planilha de Origem
    FinalOrigem = wsPlanOrigem.Cells(65000, Coluna1Origem + 2).End(xlUp).Row
    ' total de linhas na planilha de Destino + 2
    FinalDestino = wsPlanDestino.Cells(65000, Coluna1Destino + 2).End(xlUp).Row + 2
    
    ' para cada linha na tabela original
    For i = 1 To FinalOrigem + 1
        
        ' se a celula seleciona for diferente de vazio
        If wsPlanOrigem.Cells(i, Coluna1Origem + 2).Value <> "" Then
             
            ' se cont for igual a 0
            If Cont = 0 Then
                wsPlanDestino.Activate
                wsPlanDestino.Range(Cells(FinalDestino, Coluna1Destino), Cells(FinalDestino, Coluna1Destino + 5)).MergeCells = True
                wsPlanDestino.Range(Cells(FinalDestino, Coluna1Destino), Cells(FinalDestino, Coluna1Destino + 5)).Select
                With Selection
                    .HorizontalAlignment = xlCenter
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Font.Bold = True
                    .Font.Size = 15
                    .Interior.Color = 13796678 ' azul escuro
                    .Value = UCase(wsPlanOrigem.Cells(i, Coluna1Origem + 2).Value)
                End With
                                
                Indice = Indice + 1
                Cont = Cont + 1
                ContItens = 0
            
            ' caso Cont nao for igual a 0
            Else
            
                ' verifica se é a primeira passada (se for vai criar e formatar a descricao das colunas)
                If ContItens = 0 Then
                    
                    wsPlanDestino.Activate
                    ' formatacao das celulas
                    wsPlanDestino.Range(Cells(FinalDestino + 1, Coluna1Destino), Cells(FinalDestino + 1, Coluna1Destino + 5)).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .Interior.Color = 15717823 ' Azul Claro
                        .Font.Bold = True
                    End With
                    
                    ' adicao de valores e formatacao das celulas
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino).Value = "Sequência"
                    wsPlanDestino.Columns("A:A").ColumnWidth = 12
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 1).Value = "Data Movimento"
                    wsPlanDestino.Columns("B:B").ColumnWidth = 20
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 2).Value = "Descrição"
                    wsPlanDestino.Columns("C:C").ColumnWidth = 100
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 3).Value = "Saídas"
                    wsPlanDestino.Columns("D:D").ColumnWidth = 10
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 4).Value = "Entradas"
                    wsPlanDestino.Columns("E:E").ColumnWidth = 10
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 5).Value = "Totais"
                    wsPlanDestino.Columns("F:F").ColumnWidth = 10
                    
                    ' comeca a contagem dos itens
                    ContItens = ContItens + 1
                    
                End If
                
                ' seta em FinalDestino a ultima linha preenchida
                FinalDestino = wsPlanDestino.Cells(65000, 1).End(xlUp).Row
                
                ' caso ja existam itens...
                If ContItens > 0 Then
                
                    ' coluna sequencia
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "000000"
                        .Value = ContItens
                    End With
                    
                    ' coluna Data Movimentacao
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 1).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "dd/mm/yyyy"
                        .Value = wsPlanOrigem.Cells(i, Coluna1Origem).Value
                    End With
                    
                    ' coluna Descricao
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 2).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .WrapText = True
                        .Value = wsPlanOrigem.Cells(i, Coluna1Origem + 2).Value
                    End With
                    
                    ' coluna Saidas
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 3).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "0.00"
                        .Value = wsPlanOrigem.Cells(i, Coluna1Origem + 3).Value
                    End With
                    
                    ' coluna Entradas
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 4).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "0.00"
                        .Value = wsPlanOrigem.Cells(i, Coluna1Origem + 4).Value
                    End With
                    
                    ' coluna Totais
                    wsPlanDestino.Cells(FinalDestino + 1, Coluna1Destino + 5).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "#,##0.00""d"";#,##0.00""c"";#,##0.00"
                        .Value = wsPlanOrigem.Cells(i, Coluna1Origem + 5).Value
                    End With
                    
                    ' verificar a duplicidade deste item
                    ContItens = ContItens + 1
                
                End If
            End If
            
        Else
            
            ' verifica se esta passando por um intervalo ou ja chegou no final
            If wsPlanOrigem.Cells(i - 1, Coluna1Origem + 2).Value <> "" And wsPlanOrigem.Cells(i, Coluna1Origem + 2).Value = "" And wsPlanOrigem.Cells(i + 1, Coluna1Origem + 2).Value = "" Or wsPlanOrigem.Cells(i + 2, Coluna1Origem + 2).Value = "" Then
                
                ' seta em FinalDestino o valor da ultima celula preenchida
                FinalDestino = wsPlanDestino.Cells(65000, 1).End(xlUp).Row
                
                ' faz um loop de 3 linhas
                ' 1 - linha em branco
                ' 2 - linha com os totais das entradas e saidas
                ' 3 - linha em branco
                For y = 1 To 3
                    
                    ' coluna sequencia
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    End With
                    
                    ' coluna Data Movimentacao
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino + 1).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    End With
                    
                    ' coluna Descricao
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino + 2).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    End With
                    
                    ' Saidas - Encerramento
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino + 3).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "0.00"
                        .Value = wsPlanOrigem.Cells(i + y - 1, Coluna1Origem + 3).Value
                    End With
                    
                    ' Entradas - Encerramento
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino + 4).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                        .NumberFormat = "0.00"
                        .Value = wsPlanOrigem.Cells(i + y - 1, Coluna1Origem + 4).Value
                    End With
                    
                    ' Totais - Encerramento
                    wsPlanDestino.Cells(FinalDestino + y, Coluna1Destino + 5).Select
                    With Selection
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    End With
                        
                Next
                
                FinalDestino = wsPlanDestino.Cells(65000, ColunaDestino + 2).End(xlUp).Row + 4
                wsPlanDestino.Range(Cells(FinalDestino, Coluna1Destino), Cells(FinalDestino, Coluna1Destino + 5)).MergeCells = True
                wsPlanDestino.Cells(FinalDestino, Coluna1Destino).Select
                With Selection
                    .HorizontalAlignment = xlCenter
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Font.Bold = True
                    .Font.Size = 13
                    .NumberFormat = "000000000"
                    .Interior.Color = 15717823 ' azul claro
                    .Value = Indice
                End With
                
                ' total de linhas na planilha de Destino
                FinalDestino = wsPlanDestino.Cells(65000, Coluna1Destino).End(xlUp).Row + 3
                
            Else
                ' zera contador
                Cont = 0
            End If
            
        End If
        
    Next
    
End Sub

Fiz especialmente por desafio.. kkk

Se voce gostar.... postaí...

Se for Util... Votaí... 8D

Answer 3

Gildson Silva

Gildson Silva o que vale que vc criou um codigo e postou, valeu pela sua dedicação e tb agradeço a tds que postaram neste forum e me ajudaram.

Obrigado

Answer 4

Gildson Silva

Gildson Silva o que vale que vc criou um codigo e postou, valeu pela sua dedicação e tb agradeço a tds que postaram neste forum e me ajudaram.

Obrigado

Cara... Faz o seguinte... Roda o codigo e me diz o que voce achou... Ele nao vai alterar a tabela original nao... Ele cria uma nova tabela.... Dá um preview aí de como ficaria sua tabela.... 8)