locked
Macro para organizar dados II RRS feed

  • Pergunta

  • Bom dia, Adilson!

     

    Enviei para seu email uma solicitação de alteração na macro que você criou. Fico grato se puder me ajudar mais uma vez.

     

     

    Um abraço

     

    quarta-feira, 13 de fevereiro de 2008 10:39

Respostas

  • Segue abaixo o código da última versão enviada.

    Code Snippet

    Option Explicit

    Sub TransferirdePlan2paraPlan3()
    Dim N As Integer, i As Integer, k As Integer
    Dim Reg As String
    Dim Origem As Worksheet, Destino As Worksheet

    'Atribuição das planilhas de origem e destino das informações
    Set Origem = Sheets("Plan2")
    Set Destino = Sheets("Plan3")
        With Origem
        N = Origem.Cells(Rows.Count, 8).End(xlUp).Row
            'Loop para percorrer as linhas preenchidas da coluna A em Plan2
            For i = 5 To N
                Reg = Left(.Cells(i, 8).Value, 3)
                'Teste do valor da coluna A em Plan2 e conseqüente alocação por intervalo
                'de dados na Plan3
                Select Case Reg
                Case "CAP", "FRT"
                k = Application.WorksheetFunction.CountA(Range("CAP_FRT"))
                k = k + 9
                Case "FEE"
                k = Application.WorksheetFunction.CountA(Range("FEE"))
                k = k + 51
                Case Else
                Exit For
                End Select
                'Transfere os dados para a região determinada na Plan3
                If Reg = "CAP" Or Reg = "FRT" Then
                    'Testa se o valor do Nº B/L já existe
                    If .Cells(i, 6) <> Destino.Cells(k - 1, 1) Then
                    'Caso não exista transfere os dados
                    Destino.Cells(k, 1) = .Cells(i, 6)
                    Destino.Cells(k, 3) = .Cells(i, 3)
                    Destino.Cells(k, 5) = CDec(.Cells(i, 15))
                    Else
                    'Se existir sobrepõe os campos de texto e soma os valores
                    Destino.Cells(k - 1, 1) = .Cells(i, 6)
                    Destino.Cells(k - 1, 3) = .Cells(i, 3)
                    Destino.Cells(k - 1, 5) = CDec(.Cells(i, 15)) + Destino.Cells(k - 1, 5)
                    End If
                Else
                    'Insere os registros se for FEE
                    Destino.Cells(k, 1) = .Cells(i, 6)
                    Destino.Cells(k, 3) = .Cells(i, 3)
                    Destino.Cells(k, 5) = CDec(.Cells(i, 15))
                End If
            Next i
        End With
    End Sub

     

     


    []s

    terça-feira, 19 de fevereiro de 2008 18:18

Todas as Respostas

  •  JVieira wrote:

    Bom dia, Adilson!

     

    Enviei para seu email uma solicitação de alteração na macro que você criou. Fico grato se puder me ajudar mais uma vez.

     

     

    Um abraço

     

     

    Bom dia, meu caro!

    Já verifiquei a chegada do e-mail, mas só devo poder cuidar do assunto, hoje à noite.

    Espero que te atenda.

     

    [ ]s

    quarta-feira, 13 de fevereiro de 2008 13:29
  •  Adilson Soledade wrote:
     JVieira wrote:

    Bom dia, Adilson!

     

    Enviei para seu email uma solicitação de alteração na macro que você criou. Fico grato se puder me ajudar mais uma vez.

     

     

    Um abraço

     

     

    Bom dia, meu caro!

    Já verifiquei a chegada do e-mail, mas só devo poder cuidar do assunto, hoje à noite.

    Espero que te atenda.

     

    [ ]s

     

    Ok, não tenho tanta urgência.

     

    Muito obrigado,

     

    Jerson

    quarta-feira, 13 de fevereiro de 2008 13:37
  • Jerson,

    Te enviei o arquivo modificado ontem à noite.

    Qdo puder, dê uma olhada.

    [ ]s

     

    quinta-feira, 14 de fevereiro de 2008 12:53
  •  Adilson Soledade wrote:

    Jerson,

    Te enviei o arquivo modificado ontem à noite.

    Qdo puder, dê uma olhada.

    [ ]s

     

     

     

    Adilson,

     

    Não funcionou. Não aparece nenhuma msg de erro, mas simplesmente não transfere nenhum dado.

     

     

    Abraço,

     

    Jerson

    quinta-feira, 14 de fevereiro de 2008 15:33
  • Estranho...

    Me diz qual o passo a passo que vc está usando para rodar as macros com base no arquivo que vc mandou.

    Precisaria rodar só a macro de transferência de dados.

    PS: sei que fui que ajudei a montá-las, mas com tantos códigos fica difícil lembrar a lógica de todos eles.

    [ ]s

     

    quinta-feira, 14 de fevereiro de 2008 15:42
  •  Adilson Soledade wrote:

    Estranho...

    Me diz qual o passo a passo que vc está usando para rodar as macros com base no arquivo que vc mandou.

    Precisaria rodar só a macro de transferência de dados.

    PS: sei que fui que ajudei a montá-las, mas com tantos códigos fica difícil lembrar a lógica de todos eles.

    [ ]s

     

     

    Bem, primeiro eu importo o arquivo (ImportTextFile), depois eu elimino as linhas em branco (tratar), depois eu elimino os pos/neg (Eliminar_Repetidos) e por último transfiro os dados para a PLAN3 (TansferirdePlan2paraPlan3).

     

    Sds

    Jerson

     

     

    quinta-feira, 14 de fevereiro de 2008 21:24
  • Ok.

    E o arquivo que vc me enviou já passou por quais das etapas que vc citou?

    [ ]s

    quinta-feira, 14 de fevereiro de 2008 23:02
  •  Adilson Soledade wrote:

    Ok.

    E o arquivo que vc me enviou já passou por quais das etapas que vc citou?

    [ ]s

     

    Bom dia, Adilson!

     

    Aquela havia sido importada apenas. Acabei de enviar outra já pronta para a última fase. Notar que a PLAN3 já está pronta para receber os dados no novo formato.

     

    Sds

    Jerson

    sexta-feira, 15 de fevereiro de 2008 10:41
  • Oi, meu caro.

    Mandei a versão, que acredito ser a final, para teu e-mail.

    [ ] s

     

    sexta-feira, 15 de fevereiro de 2008 20:37
  • Segue abaixo o código da última versão enviada.

    Code Snippet

    Option Explicit

    Sub TransferirdePlan2paraPlan3()
    Dim N As Integer, i As Integer, k As Integer
    Dim Reg As String
    Dim Origem As Worksheet, Destino As Worksheet

    'Atribuição das planilhas de origem e destino das informações
    Set Origem = Sheets("Plan2")
    Set Destino = Sheets("Plan3")
        With Origem
        N = Origem.Cells(Rows.Count, 8).End(xlUp).Row
            'Loop para percorrer as linhas preenchidas da coluna A em Plan2
            For i = 5 To N
                Reg = Left(.Cells(i, 8).Value, 3)
                'Teste do valor da coluna A em Plan2 e conseqüente alocação por intervalo
                'de dados na Plan3
                Select Case Reg
                Case "CAP", "FRT"
                k = Application.WorksheetFunction.CountA(Range("CAP_FRT"))
                k = k + 9
                Case "FEE"
                k = Application.WorksheetFunction.CountA(Range("FEE"))
                k = k + 51
                Case Else
                Exit For
                End Select
                'Transfere os dados para a região determinada na Plan3
                If Reg = "CAP" Or Reg = "FRT" Then
                    'Testa se o valor do Nº B/L já existe
                    If .Cells(i, 6) <> Destino.Cells(k - 1, 1) Then
                    'Caso não exista transfere os dados
                    Destino.Cells(k, 1) = .Cells(i, 6)
                    Destino.Cells(k, 3) = .Cells(i, 3)
                    Destino.Cells(k, 5) = CDec(.Cells(i, 15))
                    Else
                    'Se existir sobrepõe os campos de texto e soma os valores
                    Destino.Cells(k - 1, 1) = .Cells(i, 6)
                    Destino.Cells(k - 1, 3) = .Cells(i, 3)
                    Destino.Cells(k - 1, 5) = CDec(.Cells(i, 15)) + Destino.Cells(k - 1, 5)
                    End If
                Else
                    'Insere os registros se for FEE
                    Destino.Cells(k, 1) = .Cells(i, 6)
                    Destino.Cells(k, 3) = .Cells(i, 3)
                    Destino.Cells(k, 5) = CDec(.Cells(i, 15))
                End If
            Next i
        End With
    End Sub

     

     


    []s

    terça-feira, 19 de fevereiro de 2008 18:18
  • Boa tarde, Adilson!

     

    Desculpe-me pela demora da resposta. Este último código funciona perfeitamente e atende totalmente a minha necessidade. Muito obrigado, mais uma vez.

     

    Caso surja a necessidade de algum ajuste, vou voltar a incomodá-lo... hehehehehe

     

    Um grande abraço.

     

     

    Sds

    Jerson

    quinta-feira, 21 de fevereiro de 2008 16:20
  • Sempre às ordens, Jerson.

    Por favor, marque o tópico como respondido.

    Até a próxima,

    [ ]s

    quinta-feira, 21 de fevereiro de 2008 16:24