Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Daeron

Fazer macro se repetir na linha seguinte - VBA

Recommended Posts

Pessoal, estou com um problemão em relação a uma macro que estou fazendo no VBA.

 

Estou automatizando uma rotina de relatórios aqui na empresa. A parte de formatação do relatório está perfeita, ficou até melhor do que esperava, mas o batimento deste relatório é que está me dando dor de cabeça...

 

Vou mostrar um exemplo de como o relatório fica e como ele deve ser trabalhado:

 

O relatório fica assim:

 

 

 

NEO MXM

COLUNA.A COLUNA.B COLUNA. C COLUNA.D COLUNA E COLUNA F COLUNA G

EMPRESA 1 FATURA VALOR DIFERENÇA VALOR FATURA EMPRESA

 

EMPRESA(A) 100/08 100,00 0,00 100,00 100/08 EMPRESA(A)

EMPRESA(B) 196/08 194,56 -94,56 100,00 148/08 EMPRESA©

EMPRESA© 148/08 100,00 100,00

 

 

Isto é somente um exemplo da tabela, pois a quantidade de registros é brutal. Na verdade eu gero o mesmo relatório em 2 programas diferentes pois um (NEO) contém os dados das faturas que estão sendo trabalhadas pelos analistas e o outro (MXM), contém os dados de pagamento das faturas e em que mês foram pagas.

No caso, a macro deveria comparar o valor e a fatura do NEO com o valor e a fatura do MXM, sendo encontrado alguma divergência entre os dois, ele tem que selecionar a parte da tabela que está com o maior valor e jogar uma linha para baixo, empurrando todos os outros registros abaixo 1 célula a mais.

Esta parte de identificar qual é o maior e descer uma única linha está funcionando bem, mas o problema é quando ele tem que fazer uma nova comparação com a segunda linha...

 

Sendo assim, sempre que a fatura se igualar entre as colunas ele deve partir para a próxima linha e verificar, veja como ficaria

 

 

EMPRESA(A) 100/08 100,00 0,00 100,00 100/08 EMPRESA(A)

EMPRESA(B) 196/08 194,56 -194,56

EMPRESA© 148/08 100,00 0,00 100,00 148/08 EMPRESA©

 

O código acabei tendo que fazer propositalmente pra ficar omente com uma linha de trabalho pois não conseguí fazer o que estou querendo, vejam o código:

 

Sub TESTE_BATIMENTO()

 

Dim CEL1 As Integer

Dim CEL2 As Integer

Dim CONT As Integer

 

CEL1 = Range("F3")

CEL2 = Range("H3")

CONT = 3

 

Do While Cells(CONT, 6) <> ""

CONT = CONT + 1

CEL1 = CEL1 + 1

CEL2 = CEL2 + 1

Loop

 

If CEL1 > CEL2 Then

 

If CEL1 <> CEL2 Then

 

Range("A3:F3").Select

Selection.Insert Shift:=xlDown

 

Else

 

Range("G3") = CEL2 - CEL1

 

End If

 

ElseIf CEL1 < CEL2 Then

 

If CEL2 <> CEL1 Then

 

Range("H3:L3").Select

Selection.Insert Shift:=xlDown

 

Else

 

Range("G3") = CEL2 - CEL1

 

End If

 

End If

 

End Sub

Por favor, alguém sabe como resolvo isso? Espero não ter viajado demais na explicação http://forum.imasters.com.br/public/style_emoticons/default/grin.gif

Compartilhar este post


Link para o post
Compartilhar em outros sites

Nunca mexi com VBA, mas ja tentou um laço de repetição pra mudar as linha?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Cara tem como você me dar um exemplo de como se faz isso?

 

Eu já dei uma limpada no código por que tinham coisas que não estavam sendo usadas em nenhum momento, mas como fazer pra repetir essa função a cada linha, realmente não sei como fazer.

 

O VBA é muito paecido com o VB, então se souber como se faz...

 

Obrigado

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sub TESTE_BATIMENTO()

Dim CEL1 As Integer
Dim CEL2 As Integer
Dim CONT As Integer
For i=3 To NUMERO_DE_LINHAS
CEL1 = Range("F" & i)
CEL2 = Range("H" & i)
CONT = 3

Do While Cells(CONT, 6) <> ""
CONT = CONT + 1
CEL1 = CEL1 + 1
CEL2 = CEL2 + 1
Loop

If CEL1 > CEL2 Then

If CEL1 <> CEL2 Then

Range("A" & i & ":F" & i).Select
Selection.Insert Shift:=xlDown

Else

Range("G" & i) = CEL2 - CEL1

End If

ElseIf CEL1 < CEL2 Then

If CEL2 <> CEL1 Then

Range("H" & i & ":L" & i).Select
Selection.Insert Shift:=xlDown

Else

Range("G" & i) = CEL2 - CEL1

End If

End If
Next
End Sub

Acho que alguma coisa assim deve resolver.

 

Flw

Compartilhar este post


Link para o post
Compartilhar em outros sites

Cara muito obrigado pela sua dica, realmente funcionou do jeito que eu queria!!!

 

Mas ainda estou tendo um problema, o batimento está rolando legal mas quando chega na linha 707 ele dá um erro... "Erro em tempo de execução (6). Estouro"

 

Eis o código que estou usando:

Sub PREP_BATIMENTO()

Dim CEL1 As Integer
Dim CEL2 As Integer
Dim CONT As Integer

CONT = 3


Do Until Cells(CONT, 6) <> ""
	CONT = CONT + 1
Loop

   For i = CONT To CONT + 10000
	CEL1 = Range("F" & i)
	CEL2 = Range("H" & i)



If CEL1 > CEL2 Then

	If CEL1 <> CEL2 Then

		Range("A" & i & ":F" & i).Select
		Selection.Insert Shift:=xlDown

	End If

ElseIf CEL1 < CEL2 Then

	If CEL2 <> CEL1 Then

		Range("H" & i & ":L" & i).Select
		Selection.Insert Shift:=xlDown

	End If

End If
Next


End Sub

Alguma idéia do que pode er isso?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Provavelmente esse erro deu porque a variavel i excedeu 65k (1k = 1.000), declara ela como double e tenta de novo.

 

Dica: Utilize a tag code para colocar seu código, fica com uma melhor visualização

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.