comparer deux colonnes et copier les manquants

flo2002

XLDnaute Impliqué
Re bonjour à tous,

encore une macro bancale mais qui doit pas etre loin de fonctionner. Un coup d'oeil d'expert doit suffir.

Sub MAJ_RF()

Sheets('Extract_AFU').Visible = True
Sheets('Rolling_Forecast').Select
Cells.Select
Selection.RemoveSubtotal
Range('a1').Select

Dim Derligne1%, Derligne2%
Dim i1%, i2%
Dim Exist
Derligne1 = Sheets('Rolling_Forecast').Range('e65536').End(xlUp).Row
Derligne2 = Sheets('Extract_AFU').Range('c65536').End(xlUp).Row
For i2 = 1 To Derligne2
For i1 = 1 To Derligne1
If Sheets('Extract_AFU').Range('c2' & i2) = Sheets('Rolling_Forecast').Range('e10' & i1) Then
Exist = 1
GoTo Suivant
End If
Next
If Exist = 1 Then GoTo Suivant
Sheets('Rolling_Forecast').Range('e10' & Derligne1 + 1) = Sheets('Extract_AFU').Range('c2' & i2)
Derligne1 = Sheets('Rolling_Forecast').Range('e65536').End(xlUp).Row
Suivant:
Exist = 0
Next


Sheets('Extract_AFU').Visible = False
End Sub

Merci d'avance!

si besoin je peux donner plus d'explication quand à sa fonction.
 

Hervé

XLDnaute Barbatruc
re

value signifie valeur (que ce soit du texte ou un nombre)

en piece jointe un fichier demo;

salut [file name=Classeur4_20060613152834.zip size=7767]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur4_20060613152834.zip[/file]
 

Pièces jointes

  • Classeur4_20060613152834.zip
    7.6 KB · Affichages: 33

Gorfael

XLDnaute Barbatruc
Salut Hervé
Désolé, mais regarde ma modif de ta 'vision des choses' et dis-moi ce que tu en penses
Sub MAJ_RF()

Dim c1 As Range, c2 As Range
Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets('Rolling_Forecast')
Set ws2 = Sheets('Extract_AFU')

ws1.Cells.RemoveSubtotal

For Each c2 In ws2.Range('c2:c' & ws2.Range('c65536').End(xlUp).Row)
Exist = 0
For Each c1 In ws1.Range('e10:e' & ws1.Range('e65536').End(xlUp).Row)
If c2 = c1 Then
Exist = 1

Exit For

End If
Next c1

If Exist = 0 Then ws1.Range('e' & .Range('e65536').End(xlUp).Row + 1) = c2
Next c2
End Sub
La modif :
Exit for : si exist = 1, la cellule existe et pas besoin de continuer la boucle
J'avais trouvé d'autres erreurs, mais c'est à cause ce c1 et c2 (variables) et c2 (cellule)
C'est à cause de ce genre de problème que mes variables sont un peu plus explicites, avec une ou plusieurs lettres en majuscules, comme ça, quand je finis une ligne, je sais que j'ai pas écrit la bonne variable.
A+
 

Gorfael

XLDnaute Barbatruc
Salut
le temps que j'arrive à envoyer, déjà 5, 6 posts de + :eek:
si l'erreur se situe à la ligne
If c2 = c1 Then

essaie de modifier
If not(C2 = '') and c2 = c1 Then
ou différent de
ou not(isempty(c2))

Les problèmes viennent souvent des valeurs nulles
A+
 

flo2002

XLDnaute Impliqué
j'ai mis

If c2 = c1 Then
Exist = 1
Exit For
End If
Next c1

mais ca plante

donc j'ai mis

If c2.value = c1.value Then
Exist = 1
Exit For
End If
Next c1

mais ca plante

alors j'ai mis

If c2.text = c1.text Then
Exist = 1
Exit For
End If
Next c1

et la ca fait un moment qu'il tourne....

merci comme meme
 

Gorfael

XLDnaute Barbatruc
flo2002 écrit:
re
en copiant ceci:

If Not (c2 = '') And c2.Value = c1.Value Then

Exist = 1
Exit For
End If



quand je passe le curseur dessus il me dit:

c2.Value > c2.Value =''
c1.Value > Erreur 2023

Merci de vos lumieres!
Salut
ça veut dire qu'à priori on est en train de se focaliser sur c2, alors que l'erreur peut provenir de C1
dans les définitions de variable tu ajoutes :
Dim Var_Text as string
donc, juste avant ta ligne, tu colles 2 lignes de code :
var_text =c1.address + un point d'arrêt
Var_text = C2.adrdress
le point d'arrêt interrompra ta macro
tu avances avec F8 et tu vérifies en mettant le curseur sur Var_text, l'adresse de la cellule qui pose problème. Et dès que le problème apparait, tu vas regarder le contenu des 2 cellules que tu testes.
A+
A+
Var_text =
 

flo2002

XLDnaute Impliqué
Bonjour le forum,
et merci Gorfael, ce que tu m'as donné fonctionne bien ou presque:

tout commence bien car il cherche et trouve les manquants, mais après il a dut mal à s'arreter et donc cela dure un certain temps et il termine par un plantage. C'est le C2 qui a alors le probleme.

voici le code remanier:
Sub MAJ_RF()
Dim c1 As Range, c2 As Range
Dim Exist As Byte
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Var_Text As String


Set ws1 = Sheets('Rolling_Forecast')
Set ws2 = Sheets('Extract_AFU')


For Each c2 In ws2.Range('a2:a' & ws2.Range('a65536').End(xlUp).Row)
Exist = 0
For Each c1 In ws1.Range('e10:e' & ws1.Range('e65536').End(xlUp).Row)

Var_Text = c1.Address
Var_Text = c2.Address

If Not (c2 = '') And c2 = c1 Then Exist = 1


Next c1

If Exist = 0 Then
With ws1
.Range('e' & .Range('e65536').End(xlUp).Row + 1) = c2
End With
End If
Next c2

End Sub

Merci d'avance!
je continues les recherches de mon coté!

Message édité par: flo2002, à: 14/06/2006 08:56
 

Gorfael

XLDnaute Barbatruc
flo2002 écrit:
En partant du principe qu'il cherche dans E en fonction de C, ne pourrait on^pas lui dire de s'arreter quand il trouve la premiere valeur ''?

Merci
Salut
C'est ce que j'avais corrigé avant sur jmps
If Not (c2 = '') And c2 = c1 Then Exist = 1
tu le transforme en
If Not (c2 = '') And c2 = c1 Then
Exist = 1
Exit for
Endif
Dès que tu vas avoir la valeur de 1 pour Existe, tu peux sortir de ta boucle
L'instruction Exit For, lorsque le programme la rencontre, il va directement à l'instruction qui suit la ligne où il y a le Next
A+
 

flo2002

XLDnaute Impliqué
Merci de tes conseilles!

je t'avoues que je ne comprend plus trop car j'ai essayé beaucoup de chose avec des approches differentes pour arriver au constat suivant. Le probleme est lié au feuille. En effet, le code est juste en fonction d la feuille sur la quel je suis. en faite, il ne comprend que la partie lié à la feuille en cours. et vu que je compare deux feuille j'en ai toujours une fausse et donc il ne peut comparé.

Je suis reparti sur cette base car je sens qu'il ne manque pas grand chose.
Sub MAJ_RF()



Sheets('Rolling_Forecast').Select
Cells.Select
Selection.RemoveSubtotal
Range('a1').Select
Sheets('Extract_AFU').Visible = True
Sheets('Extract_AFU').Select



Dim Derligne1, Derligne2
Dim i1, i2
Dim Exist
Derligne1 = Sheets('Rolling_Forecast').Range('e65536').End(xlUp).Row
Derligne2 = Sheets('Extract_AFU').Range('w65536').End(xlUp).Row

Dim Feuille1, Feuille2 As Sheets

Set Feuille1 = Sheets('Rolling_Forecast')
Set Feuille2 = Sheets('Extract_AFU')


For i2 = 1 To Derligne2
For i1 = 1 To Derligne1

If Sheets('Extract_AFU').Range(Cells(2, 23) & i2) = Sheets('Rolling_Forecast').Range(Cells(10, 5) & i1) Then
Exist = 1
GoTo Suivant
End If
Next

If Exist = 1 Then GoTo Suivant
Sheets('Rolling_Forecast').Range(Cells(10, 5) & Derligne1 + 1) = Sheets('Extract_AFU').Range(Cells(2, 23) & i2)
Derligne1 = Sheets('Rolling_Forecast').Range('e65536').End(xlUp).Row
Suivant:
Exist = 0
Next



Sheets('Extract_AFU').Visible = False


End Sub

merci encore
 

Discussions similaires

Statistiques des forums

Discussions
312 391
Messages
2 087 954
Membres
103 685
dernier inscrit
janguypol