none
Preecher com numero a parti de um campo RRS feed

  • Pergunta

  • 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




    • Editado vaggnersf quarta-feira, 12 de setembro de 2012 00:18
    quarta-feira, 12 de setembro de 2012 00:14

Respostas

  • 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

    • Marcado como Resposta vaggnersf quinta-feira, 13 de setembro de 2012 00:49
    quinta-feira, 13 de setembro de 2012 00:12
    Moderador

Todas as Respostas

  • 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

    • Marcado como Resposta vaggnersf quinta-feira, 13 de setembro de 2012 00:49
    quinta-feira, 13 de setembro de 2012 00:12
    Moderador
  • 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
    quinta-feira, 13 de setembro de 2012 05:26
  • 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

    quinta-feira, 13 de setembro de 2012 23:51
  • 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)

    sexta-feira, 14 de setembro de 2012 00:45