Aos cobras em Excel

Question

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.

Answer 1

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

Answer 2

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

Answer 3

Po.. demorei..

Answer 4

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

 

 

Answer 5

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

 

Answer 6

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

 

Answer 7

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é?

Answer 8

Hideo,

Vc pode retirar a linha "Call Deleta".

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

[]s

Answer 9

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

 

Muito obrigado!

Answer 10

Hideo,

 

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

Answer 11

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

Answer 12

 

Adilson...

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

 

Answer 13

JVieira wrote:

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

´

 

Que nada, é programando que se aprende!

Answer 14

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

Answer 15

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

 

Answer 16

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

Answer 17

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 é [e-mail]

[]s

 

 

Answer 18

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

 

Answer 19

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

Answer 20

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

Answer 21

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

Answer 22

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

Answer 23

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 

 

Answer 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

 

Answer 25

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?

Answer 26

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.