locked
Aos cobras em Excel RRS feed

  • Pergunta

  • Caros amigos,

     
    Preciso criar uma macro que elimine valores pos/neg que pertençam a um mesmo documento. Exemplo:
     
    Nº. Doc.       Nome           Valor
    1234      Loja do João      100,00
    1234      Loja do João     -100,00
    1234      Loja do João      100,00
     
    Ao encontrar o mesmo número de documento com valores pos/neg a macro deve eliminar as linhas onde eles se econtram ficando apenas um documento com valor positivo.
     
    Obrigado.
    sexta-feira, 18 de janeiro de 2008 10:19

Respostas

  • Também sou novo no uso da ferramenta, mas encontrei as observações abaixo na área de FAQ:

     

    Como indicar que uma postagem respondeu à minha pergunta?
    Para marcar sua postagem como respondida, clique no botão Marcar como resposta à direita da postagem.

    Como classificar uma postagem?
    Para classificar uma postagem como útil ou não, clique em Sim ou Não ao lado do texto "Essa postagem foi útil?", na parte superior da postagem.

     

    terça-feira, 22 de janeiro de 2008 13:23

Todas as Respostas

  • Suponho que seus dados estejam nas colunas A, B e C.

    Se isto for verdade, vc pode usar o código abaixo diretamente.

    Caso contrário serão necessários alguns ajustes para adequar à tua estrutura de dados

    Code Block

    Sub Eliminar_Negativos()
    Dim Linhas As Integer, i As Integer
    Linhas = Application.WorksheetFunction.CountA(Columns(1))
    Range(Cells(2, 4), Cells(Linhas, 4)).FormulaR1C1 = "=COUNTIF(R2C1:R4C1,RC[-3])*IF(RC[-1]>0,1,-1)"
    For i = 2 To Linhas
    If Cells(i, 4).Value < -1 Then Rows(i).Delete
    Next i
    Columns(4).Delete
    End Sub

     

     

    []s

    sexta-feira, 18 de janeiro de 2008 12:13
  • Sub Deleta()
    Dim Selecao As Range
    Set Selecao = Range("a1", Selection.End(xlDown))

    For Each cell In Selecao
        cell.Activate
        If ActiveCell.Offset(0, 2).Value <= 0 Then
            ActiveCell.EntireRow.Delete (xlUp)
            Call Deleta
        End If
    Next
    End Sub
    sexta-feira, 18 de janeiro de 2008 12:30
  • Po.. demorei..
    sexta-feira, 18 de janeiro de 2008 12:32
  • Adilson,

     

    Na verdade meus dados estão da seguinte maneira:

     

    Número do documento: Col G

    Valor: Col P

     

    Quais são os ajustes necessários?

     

    Obrigado

     

     

    sexta-feira, 18 de janeiro de 2008 18:46
  • Hideo,

    2 observações em relação ao teu procedimento:

    1.  A chamada Call Deleta está ocasionando um loop do qual não há saída.

    2. O resultado esperado só é obtido se a célula ativa estiver dentro do intervalo de dados. Caso contrário serão percorridas todas as linhas do excel.

    []s

     

    sexta-feira, 18 de janeiro de 2008 18:48
  • Segue o código com as modificações:

    Code Block

    Sub Eliminar_Negativos()

    Dim Linhas As Integer, i As Integer, Contagem As Integer
    Dim ColunaReg As Integer, ColunaValor As Integer

    ColunaReg = 7       'Coluna G
    ColunaValor = 16    'Coluna P
    Linhas = Application.WorksheetFunction.CountA(Columns(ColunaReg))

    For i = 2 To Linhas
    Contagem = Application.WorksheetFunction.CountIf(Range(Cells(2, ColunaReg), Cells(Linhas, ColunaReg)), Cells(i, ColunaReg))
    If Cells(i, ColunaValor) < 0 And Contagem > 1 Then Rows(i).Delete
    Next i

    End Sub

     

     

    Onde,

    ColunaReg = nº da coluna onde se encontram os registros

    ColunaValor = nº da coluna onde se encontram os valores

    Ou seja, vc pode flexibilizar o procedimento, caso precise modificar a estrutura da tua base de dados.

     

    []s

     

    sexta-feira, 18 de janeiro de 2008 19:14
  • Sub Deleta()
    Dim Selecao As Range
    Range("G1").Activate
    Set Selecao = Range("G1", Selection.End(xlDown))

    For Each cell In Selecao
        cell.Activate
        If ActiveCell.Value < 0 Then
            ActiveCell.EntireRow.Delete (xlUp)
            Call Deleta
        End If
    Next
    End Sub

    Hum... Adilson... acho que agora vai né?

    sexta-feira, 18 de janeiro de 2008 19:15
  • Hideo,

    Vc pode retirar a linha "Call Deleta".

    Não há necessidade de chamar o procedimento de dentro dele mesmo.

    []s

    sexta-feira, 18 de janeiro de 2008 19:23
  • Show de bola, Adilson, funciona legal. Só não elimina tudo de uma só vez, mas isso não importa.

     

    Muito obrigado!

    sexta-feira, 18 de janeiro de 2008 19:33
  • Hideo,

     

    Não cheguei a testar a sua, mas mesmo assim valeu, muito obrigado!

    sexta-feira, 18 de janeiro de 2008 19:35
  •  JVieira wrote:

    Show de bola, Adilson, funciona legal. Só não elimina tudo de uma só vez, mas isso não importa.

     

    Muito obrigado!

     

     

    Adilson,

     

    Analisando mais atentamente, percebi que a macro está excluindo apenas o o documento com valor negativo, mas não o seu correspondente positivo. Tem solução?

     

    Obrigado

    sexta-feira, 18 de janeiro de 2008 20:03
  •  

    Adilson...

    Eu não testei, mas se existirem dois valores negativos seguidos, um vai ser deletado, e o outro vai ficar, não?

     

    sexta-feira, 18 de janeiro de 2008 21:27
  •  JVieira wrote:

    Hideo,

     

    Não cheguei a testar a sua, mas mesmo assim valeu, muito obrigado!

    ´

     

    Que nada, é programando que se aprende!

    sexta-feira, 18 de janeiro de 2008 21:29
  • Acho que houve um erro de interpretação da minha parte. Entendi que deveria excluir apenas os valores negativos para os quais houvesse mais de um registro.

    Com as alterações abaixo o código irá preservar apenas um dos registros.

    Code Block

    Sub Eliminar_Negativos()

    Dim Linhas As Integer, i As Integer, Contagem As Integer
    Dim ColunaReg As Integer, ColunaValor As Integer

    ColunaReg = 7       'Coluna G
    ColunaValor = 16    'Coluna P
    Linhas = Application.WorksheetFunction.CountA(Columns(ColunaReg))

    For i = Linhas To 2 Step -1
    Contagem = Application.WorksheetFunction.CountIf(Range(Cells(2, ColunaReg), Cells(Linhas, ColunaReg)), Cells(i, ColunaReg))
    If Contagem > 1 Then Rows(i).Delete
    Next i

    End Sub

     

    Espero que tenha finalmente atendido à tua necessidade.

    Mas se ainda não foi desta vez, vamos continuar até acertar.

    []s

    sexta-feira, 18 de janeiro de 2008 22:38
  •  Hideo Kawashima wrote:

     

    Adilson...

    Eu não testei, mas se existirem dois valores negativos seguidos, um vai ser deletado, e o outro vai ficar, não?

     

     

    É uma questão relativa à forma em que o loop está funcionando, pois ele percorre uma coleção de objetos Range e não conseguimos controlar a sequência de escolha.

    Se observar a última versão do meu código vai observar que coloquei o loop em ordem decrescente, garantindo que este problema não ocorra.

    Até onde conheço é a melhor estratégia para os casos em que lidamos com exclusão de linhas.

    []s

     

    sexta-feira, 18 de janeiro de 2008 22:42
  • Bom dia, Adilson!

     

    Ainda não foi dessa vez. Ela está eliminando muitas linhas além das pos/neg. Acho que deveria ter mencionado que os dados iniciam na linha 5, talvez seja isso...

    segunda-feira, 21 de janeiro de 2008 11:06
  • Vamos tentar uma abordagem diferente?

    Vc poderia me mandar a tua planilha ou um fac-simile dela, destacando a lógica de exclusão das informações e que dados devem permanecer na base?

    Terei prazer em ajudá-lo na medida em que entenda melhor a tua necessidade.

    O e-mail é adilsonsoledade@hotmail.com

    []s

     

     

    segunda-feira, 21 de janeiro de 2008 11:48
  • Jerson,

    Segue o código modificado.

    Estão sendo excluídos os valores negativos cujo nº de registro seja igual a um lançamento anterior.

    Sendo assim dos valores que vc me enviou na planilha foram exclusos os valores negativos destacados em vermelho e mantidas as suas contrapartidas com valores positivos.

    Acho que agora vai...

     

    Code Block

    Sub Eliminar_Negativos()

    Dim Linhas As Integer, i As Integer, Contagem As Integer
    Dim ColunaReg As Integer, ColunaValor As Integer, LinhaInicial As Integer
    Dim ValorBusca As Variant
    Dim IntervaloBusca As Range

    LinhaInicial = 5    'Linha 5
    ColunaReg = 6       'Coluna F
    ColunaValor = 15    'Coluna O
    Linhas = Application.WorksheetFunction.CountA(Columns(ColunaReg)) + LinhaInicial - 1
    Range(Cells(LinhaInicial, 255), Cells(Linhas, 255)).FormulaR1C1 = "=RC[-249]&ABS(RC[-240])"
    Set IntervaloBusca = Range(Cells(LinhaInicial, 255), Cells(Linhas, 255))

    For i = Linhas To LinhaInicial Step -1
    ValorBusca = Cells(i, ColunaReg).Value & Abs(Cells(i, ColunaValor).Value)
    Contagem = Application.WorksheetFunction.CountIf(IntervaloBusca, ValorBusca)
    If Contagem > 1 And Cells(i, ColunaValor).Value < 0 Then Rows(i).Delete
    Next i

    Columns(255).Delete

    End Sub

     

    []s

     

    segunda-feira, 21 de janeiro de 2008 17:46
  • Adilson,

     

    Continua excluindo somente os negativos. Na planilha exemplo que te enviei, as seis linhas destacadas em vermelho dever ser excluídas. Notar abaixo descrição:

     

    Linhas 10, 11 e 12 = lançamento incorreto (pos.) deve ser excluído

    Linhas 15, 17 e 18 = lançamento de exclusão (neg.) deve ser excluído

    Linhas 16, 19 e 20 = lançamento correto (pos.) não deve ser excluído

     

    Abraço,

     

    Jerson

    segunda-feira, 21 de janeiro de 2008 18:21
  • Agora ficou mais claro.

    A questão que estava pegando eram as linhas 16, 19 e 20

    Segue abaixo o código modificado.

     

    Code Block

    Sub Eliminar_Repetidos()

    Dim Linhas As Integer, LinhaInicial As Integer
    Dim ColunaReg As Integer, ColunaValor As Integer


    Application.ScreenUpdating = False

    LinhaInicial = 5    'Linha 5
    ColunaReg = 6       'Coluna F
    ColunaValor = 15    'Coluna O

    'Determinação da última linha com registros
    Linhas = Application.WorksheetFunction.CountA(Columns(ColunaReg)) + LinhaInicial - 1

    'Criação de uma coluna de informações de Registro & Valor Absoluto para valores negativos

    Range(Cells(LinhaInicial, 256), Cells(Linhas, 256)).FormulaR1C1 = _
    "=IF(RC[-" & (256 - ColunaValor) & "]<0,RC[-" & (256 - ColunaReg) & "]&ABS(RC[-" & (256 - ColunaValor) & "]),0)"


    'Criação de uma coluna de informações de Registro & Valor Absoluto
    Range(Cells(LinhaInicial, 255), Cells(Linhas, 255)).FormulaR1C1 = _
            "=RC[-" & (255 - ColunaReg) & "]&ABS(RC[-" & (255 - ColunaValor) & "])"

    'Determinação da Exclusão ou manutenção da linha
    Range(Cells(LinhaInicial, 254), Cells(Linhas, 254)).FormulaR1C1 = _
            "=IF(ISERROR(MATCH(RC[1],RC[2]:R[49]C[2],0)),""Manter"",""Excluir"")"

    'Cópia e sobreposição do intervalo de fórmulas como valores
    Range(Cells(LinhaInicial, 254), Cells(Linhas, 256)).Copy
    Range(Cells(LinhaInicial, 254), Cells(Linhas, 256)).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    'Eliminação das linhas em que houve duplicidade do Registro & Valor
    For i = Linhas To LinhaInicial Step -1
    If Cells(i, 254) = "Excluir" Then Rows(i).Delete
    Next i

    'Eliminação das colunas com fórmulas
    Columns(254).Delete
    Columns(254).Delete
    Columns(254).Delete
    Range("F4").Select

    Application.ScreenUpdating = True

    End Sub

     

     


    Deu certo nos testes de bancada, eliminando apenas as primeiras ocorrências da repetição.

    Peço que teste e me avise se dá certo para o teu caso.

    []s

    segunda-feira, 21 de janeiro de 2008 22:09
  • Bom dia, Adilson!

     

    Infelizmente ainda não foi dessa vez. Eu testei tanto na planilha "mãe" quanto naquela que te enviei e o resultado é o mesmo: não exclui nenhuma linha.

     

    Um abraço,

     

    Jerson

    terça-feira, 22 de janeiro de 2008 10:44
  •  JVieira wrote:

    Bom dia, Adilson!

     

    Infelizmente ainda não foi dessa vez. Eu testei tanto na planilha "mãe" quanto naquela que te enviei e o resultado é o mesmo: não exclui nenhuma linha.

     

    Um abraço,

     

    Jerson

     

    Bom dia, meu caro.

    Você poderia conferir se os dados com registros e lançamentos estão realmente alocados nas colunas F e O respectivamente.

    Acabo de rodar novamente na planilha que vc me enviou e está funcionando sem problemas.

    Estou postanto o arquivo no link abaixo para que vc possa dar uma olhada.

    http://www.4shared.com/file/35561059/eed7e5a6/JVieira.html

    []s

    terça-feira, 22 de janeiro de 2008 11:38
  • Adilson,

     

    Baixei o arquivo e copiei a macro de lá e funcionou. Não entendi o por quê, mas agora está funcionando perfeitamente.

     

    Mais uma vez muito obrigado e parabéns pelo trabalho.

     

     

    Um grande abraço,

     

    Jerson Vieira 

     

    terça-feira, 22 de janeiro de 2008 12:24
  • Não há de quê.

    O importante é que está funcionando.

    Precisando, estou por aqui.

    Só te lembro de dar conclusão ao tópico do fórum.

    []s

     

    terça-feira, 22 de janeiro de 2008 12:45
  •  Adilson Soledade wrote:

    Só te lembro de dar conclusão ao tópico do fórum.

    []s

     

     

    Como faço pra concluir o tópico?

    terça-feira, 22 de janeiro de 2008 12:51
  • Também sou novo no uso da ferramenta, mas encontrei as observações abaixo na área de FAQ:

     

    Como indicar que uma postagem respondeu à minha pergunta?
    Para marcar sua postagem como respondida, clique no botão Marcar como resposta à direita da postagem.

    Como classificar uma postagem?
    Para classificar uma postagem como útil ou não, clique em Sim ou Não ao lado do texto "Essa postagem foi útil?", na parte superior da postagem.

     

    terça-feira, 22 de janeiro de 2008 13:23