Ir para conteúdo
Fórum Script Brasil

felixxsp

Membros
  • Total de itens

    2
  • Registro em

  • Última visita

Sobre felixxsp

felixxsp's Achievements

0

Reputação

  1. Ok, o problema já foi resolvido com a ajuda do amigo Nelson (sonnel). que me enviou a seguinte rotina: Public Sub AjustarDados() '* Autor: Nelson S '* Alterado em: 27/03/2011 '* Contato: nelsonnsu@gmail.com On Error GoTo PROC_ERR Const cPLAN As String = "Plan1" Const cPLAN_DADOS As String = "Dados" Const cLINHA As String = "A1:M1" Const cIDENTIF As String = "»»Operador:" Dim strMsg As String Dim lngTipoMsg As Long Dim strTitMsg As String Dim wkb As Workbook Dim wks1 As Worksheet Dim wks2 As Worksheet Dim rng As Range Dim lngLF As Long Dim lngI As Long Dim strOperador As String strMsg = "Dados ajustados" lngTipoMsg = vbInformation strTitMsg = "OK" Application.DisplayAlerts = False Application.ScreenUpdating = False Set wkb = ThisWorkbook Set wks1 = wkb.Worksheets(cPLAN) Set rng = wks1.Range(cLINHA) lngLF = wks1.Range("A" & wks1.Rows.Count).End(xlUp).Row wkb.Worksheets(cPLAN_DADOS).Delete wkb.Worksheets.Add After:=wkb.Worksheets(wkb.Worksheets.Count) Set wks2 = wkb.Worksheets(wkb.Worksheets.Count) wks2.Name = cPLAN_DADOS wks2.Range("A1:M1") = _ Array("Dt Emiss", "Nome", "Contrato", "Tipo", "Status", "N. Número", "Parcelas", _ "Receita", "Valor", "Valor Pago", "Dt Pgto", "Dt Venc", "Operador") wks2.Range("A1:M1").Font.Bold = True strOperador = vbNullString For lngI = 1 To lngLF If InStr(rng.Cells(1, 1), cIDENTIF) > 0 Then strOperador = rng.Cells(1, 1) End If If IsDate(rng.Cells(1, 1)) Then rng.Cells(1, 13) = strOperador rng.Copy wks2.Range("A" & wks2.Rows.Count).End(xlUp).Offset(1) rng.Cells(1, 13) = vbNullString End If Set rng = rng.Offset(1) Next lngI wks2.Columns.AutoFit wks2.Rows("2:2").Select ActiveWindow.FreezePanes = True wks2.Range("A1").Select PROC_EXIT: Application.DisplayAlerts = True Application.ScreenUpdating = True If Not rng Is Nothing Then Set rng = Nothing If Not wks2 Is Nothing Then Set wks2 = Nothing If Not wks1 Is Nothing Then Set wks1 = Nothing If Not wkb Is Nothing Then Set wkb = Nothing MsgBox strMsg, lngTipoMsg, strTitMsg Exit Sub PROC_ERR: If Err.Number = 9 Then Resume Next Err.Clear End If strMsg = "Erro número: " & Err.Number & vbCrLf & "Descrição: " & Err.Description & vbCrLf & _ "Módulo: AjusteDados" & vbCrLf & "Rotina: AjustarDados" lngTipoMsg = vbCritical strTitMsg = "Erro" GoTo PROC_EXIT End Sub
  2. Bom dia Pessoal. Uso um relatorio no meu trabalho, onde preciso vincular o nome do cobrador ao contrato aguardando pagamento, porém o nome do cobrador vem em uma celula separada e os contratos logo abaixo, da seguinte forma: Cada dado vem numa celula diferente, mas aki ficou tudo junto. ehhehe (coluna A, B, C e D) cobrador: Amanda »»»»Status: aguardando pagamento contrato parcela valor vencimento 7926 18 a 18 R$ 740,00 22/02/2011 8447 11 a 11 R$ 275,00 22/02/2011 8843 21 a 22 R$ 596,00 23/02/2011 6386 42 a 42 R$ 177,00 22/02/2011 7549 24 a 24 R$ 199,00 23/02/2011 8957 6 a 6 R$ 188,00 22/02/2011 8867 7 a 7 R$ 354,00 22/02/2011 8174 15 a 15 R$ 2.220, 24/02/2011 6835 33 a 35 R$ 518,00 23/02/2011 8020 15 a 17 R$ 994,00 22/02/2011 5555 16 R$ 500,00 22/02/2012 cobrador: Amaury »»»»Status: aguardando pagamento contrato parcela valor vencimento 8457 3 a 3 R$ 382,00 22/02/2011 7653 28 a 28 R$ 1.100, 22/02/2011 6186 2 a 2 R$ 192,00 23/02/2011 7649 31 a 31 R$ 176,00 22/02/2011 8057 34 a 34 R$ 194,00 22/02/2011 8167 6 a 6 R$ 198,00 22/02/2011 cobrador:JOAO »»»»Status: aguardando pagamento contrato parcela valor vencimento 8457 3 a 3 R$ 382,00 22/02/2011 8743 28 a 28 R$ 172,00 22/02/2011 6186 2 a 2 R$ 192,00 23/02/2011 7649 31 a 31 R$ 176,00 22/02/2011 8057 34 a 34 R$ 194,00 22/02/2011 8167 6 a 6 R$ 198,00 22/02/2011 então eu preciso saber uma forma de repassar o nome do cobrador para a mesma linha do contrato para ficar assim: cobrador: Amanda »»»»Status: aguardando pagamento contrato parcela valor vencimento Nome Copiado 7926 18 a 18 R$ 740,00 22/02/2011 Amanda 8447 11 a 11 R$ 275,00 22/02/2011 Amanda 8843 21 a 22 R$ 596,00 23/02/2011 Amanda 6386 42 a 42 R$ 177,00 22/02/2011 Amanda 7549 24 a 24 R$ 199,00 23/02/2011 Amanda 8957 6 a 6 R$ 188,00 22/02/2011 Amanda 8867 7 a 7 R$ 354,00 22/02/2011 Amanda 8174 15 a 15 R$ 2.220, 24/02/2011 Amanda 6835 33 a 35 R$ 518,00 23/02/2011 Amanda 8020 15 a 17 R$ 994,00 22/02/2011 Amanda 5555 16 R$ 500,00 22/02/2012 Amanda cobrador: Amaury »»»»Status: aguardando pagamento contrato parcela valor vencimento 8457 3 a 3 R$ 382,00 22/02/2011 Amaury 8743 28 a 28 R$ 1.100, 22/02/2011 Amaury 6186 2 a 2 R$ 192,00 23/02/2011 Amaury 7649 31 a 31 R$ 176,00 22/02/2011 Amaury 8057 34 a 34 R$ 194,00 22/02/2011 Amaury 8167 6 a 6 R$ 198,00 22/02/2011 Amaury cobrador:JOAO »»»»Status: aguardando pagamento contrato parcela valor vencimento 8457 3 a 3 R$ 382,00 22/02/2011 JOAO 8743 28 a 28 R$ 172,00 22/02/2011 JOAO 6186 2 a 2 R$ 192,00 23/02/2011 JOAO 7649 31 a 31 R$ 176,00 22/02/2011 JOAO 8057 34 a 34 R$ 194,00 22/02/2011 JOAO 8167 6 a 6 R$ 198,00 22/02/2011 JOAO Esse relatorio tem aproximadamente 80 cobradores, e não dá pra ser feito manualmente. A quantidade de linhas que vem abaixo do cobrador tambem pode variar muito, pois depende da produtividade deles. Alguém pode me ajudar, por favor, pois já revirei a internet toda e não consegui achar uma formula/VBA que fizesse isso automaticamente. Estou colocando em anexo uma parte da planilha para servir como teste. Sendo que essa planilha to tamanho original tem aproximadamente 750 linhas Link para o download da planilha: http://www.babooforum.com.br/forum/index.p...attach_id=24540 Ficarei eternamente grato. Obrigado.
×
×
  • Criar Novo...