Usuário com melhor resposta
Preecher com numero a parti de um campo

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
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
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
-
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 -
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)