Améliorer une procédure de comparaison avec vba

[rimbaut]

Bonsoir,

J'ai écrit ce code qui fonctionne pas trop mal et qui consiste à comparer 2 plages de cellules qui se trouvents sur 2 feuilles différentes d'un même classeur.

Ce code consiste à comparer des numéros de comptes de la feuille 1 et si un numéro n'est pas présent dans la feuille 2, l'inscrire dans la feuille 3.

 

Comme je le disais ce code fonctionne sauf que parfois, il faut exécuter plusieurs fois la macro afin de recenser l'ensemble des comptes absents. Comme ce classeur est utilisé dans des procédures comptables, c'est quelque peu problématique et l'on risque d'oublier certains comptes.

 

Je me suis demandé si le problème ne venait pas de cette fonction que j'ai écrit avec un copain :

 

Function calcMaxRow(une_feuille As String)

'Fonction qui affiche toutes les cellules non vides

Dim y As Integer

 

y = 11

Do While Sheets(une_feuille).Cells(y, 1) <> ""

y = y + 1

Loop

 

calcMaxRow = y - 1

End Function

 

le code de la procédure est celui ci :

 

Sub ComparaisonBalanceN_1()

Worksheets("comparaisonBalanceN-1").Activate

Dim cellule_2008 As Range

Dim y_comparaison As Integer

Dim range_2007, range_2008 As String

 

range_2008 = "A11:A" & calcMaxRow("BalanceN-1")

range_2007 = "A11:A" & calcMaxRow("BalanceN")

 

y_comparaison = 5

For Each cellule_2008 In Worksheets("BalanceN").Range(range_2008)

If Worksheets("balanceN-1").Range(range_2007).Find(cellule_2008.Value, LookIn:=xlValues) Is Nothing Then

Worksheets("ComparaisonBalanceN-1").Cells(y_comparaison, 1).Value = cellule_2008.Value

Worksheets("ComparaisonBalanceN-1").Cells(y_comparaison, 2).Value = cellule_2008.Offset(, 1).Value

y_comparaison = y_comparaison + 1

End If

Next cellule_2008

End Sub

 

J'ai voulu le modifier comme suit (ligne de couleur rouge) mais à l'exécution rien ne se passe :

 

Sub comparaisonBalance()

Worksheets("comparaisonBalN").Activate

Dim cellule_2007 As Range

Dim y_comparaison As Integer

Dim range_2007, range_2008 As String

 

range_2007 = "A11:A" & Sheets("balanceN-1").Range("A65536").End(xlUp).Row

range_2008 = "A11:A" & Sheets("balanceN").Range("A65536").End(xlUp).Row

 

y_comparaison = 5

' test permettant ce copier dans la feuille spécifié les n° de comptes manquants

' et les intitulés de comptes

For Each cellule_2007 In Worksheets("BalanceN-1").Range(range_2007)

If Worksheets("balanceN").Range(range_2008).Find(cell ule_2007.Value, LookIn:=xlValues) Is Nothing Then

' copie les n° de comptes manquants

Worksheets("ComparaisonBalN").Cells(y_comparaison, 1).Value = cellule_2007.Value

' copie les intitulés des numéros de cptes manqunts avec la propiriété offset

Worksheets("ComparaisonBalN").Cells(y_comparaison, 2).Value = cellule_2007.Offset(, 1).Value

y_comparaison = y_comparaison + 1

End If

Next cellule_2007

End Sub

Les noms de feuilles diffèrent entre la procédure 1 et la procédure 2 car ce sont des procédures qui traitent respectivement la feuille 1 et la feuille 2.

 

J'espère avoir été assez clair et remercie la personne qui voudra me donner un peu d'aide.

[Lupin]

Bonjour,

 

Observations :

 

Ceci ne doit pas être la cause de votre soucis, mais la déclaration

de votre variable [ range_2007 ] est incomplète.

 

La déclaration [ Dim range_2007, range_2008 As String ] sous-entend de façon explicite :

 

Dim range_2007 As Variant, range_2008 As String

 

Démonstration :

 

Sub TestVariable1()

 

Dim Lettre, Chiffre As Long

 

Lettre = Date

Chiffre = Date

 

MsgBox Lettre & vbLf & Chiffre

 

End Sub

'

 

Sub TestVariable2()

 

Dim Lettre As Date, Chiffre As Long

 

Lettre = Date

Chiffre = Date

 

MsgBox Lettre & vbLf & Chiffre

 

End Sub

 

Sub TestVariable3()

 

Dim Lettre As Date, Chiffre As Date

 

Lettre = Date

Chiffre = Date

 

MsgBox Lettre & vbLf & Chiffre

 

End Sub

 

 

n.b. Chez-moi votre syntaxe fonctionne bien :

[ range_2007 = "A11:A" & Sheets("balanceN-1").Range("A65536").End(xlUp).Row ]

 

Assurez-vous que les évènements sont toujours activés :

 

Exécuter cette procédure :

 

Sub Active_Evenements()

Application.EnableEvents = True

End Sub

 

Bonne continuité.

 

Lupin

Modifié le 14 août 2009 par Lupin