VBA : Comparer cellules+ déplacer lignes

CedricBDO

XLDnaute Nouveau
Bonjour,
J'espère que certains pourront venir à mon aide, je suis débutant en VBA (je pars de zéro mais avec des bases en C et fortran) et je dois absolument réaliser une maccro VBA.

Voila j'explique mon problème un peu plus en détails.

J'ai deux fichiers excel : "A_valider_calculs" et "Priorites".
Le fichier "A_valider_calculs" contient une feuille "Clos" et le fichier "Priorites" contient 3 feuilles : "Bidos", "Non_Bidos" et "Clos_Priorites".

Le but de la maccro VBA est de comparer la colonne A de "A_valider_calculs/Clos" avec respectivement "Priorites/Bidos" et "Priorites/Non_Bidos".
Si le contenu des cellules est le meme pour une ligne, il faut que je colorie en vert la ligne correspondante dans "Priorites/Bidos" ou "Priorites/Non_Bidos" et que je coupe cette même ligne pour la coller dans "Priorites/Clos_Priorites", sachant que ce fichier contient déjà des lignes à la base.

Petite chose en plus, Il faudrait également que cette maccro s'effectue à l'aide d'un "bouton" mise à jour qui se situerait dans la première cellule de "Priorites/Bidos" et qui afficherait la dernière date à laquelle on a cliqué dessus.

Je remercie tous ceux qui auront le temps de lire mon problème et qui m'apporteront de l'aide sachant que je galère dessus depuis pas mal de jour.




Voila a peu près la logique que je me suis fixé pour l'algorithme.
Mes fichiers ne sont pas tous ouverts lors de la maccro, seul le fichier "Priorites" l'est.


-> Ouvrir le fichier "A_Valider_Calculs"
-> Ouvrir la feuille "Clos"
-> Ouvrir le fichier "Priorites"
-> Ouvrir les feuilles "Bidos", "Non_Bidos" et "Clos_Priorites"
-> Lire les valeurs de la colonne A de "A_Valider_Calculs/Clos"
-> Lire les valeurs de la colonne A de "Priorites/Bidos" (ou de "Priorites/Non_Bidos)
-> Comparer toutes ces valeurs entre elles
-> Si des valeurs sont égales, sélectionner la ligne correspondante dans "Priorites/Bidos)
-> Colorier la ligne en vert
-> Sélectionner la première ligne vide dans la feuille "Priorites/Clos_Priorites"
-> Déplacer à cet endroit la ligne sélectionnée provenant de "Priorites/Bidos" (celle qu'on a comparer à "A_Valider_Calcul/Clos"
-> Afficher l'heure+date de la dernière utilisation de la maccro à coter du bouton de mise à jour
-> Fermer le fichier "A_Valider_Calculs"

Voila, c'est comme ca que je vois l'execution à peu près, j'espère que c'est logique.



Voila maintenant l'ébauche de code que j'ai réalisé pour l'instant.


Sub Maccro()
Dim i, j, k As Integer 'Je définis mes variables


'Je déclare les fichiers d'entrées
Workbooks.Open A_Valider_Calcul:="C:\A_Valider_Calcul.xls"
Workbooks.Open Priorites:="C:\Priorites.xls"
Workbooks("A_Valider_Calcul.xls").Activate
Workbooks("Priorites.xls").Activate
Set wk0 = Workbooks("A_Valider_Calcul.xls")
Set wk1 = Workbooks("Priorites.xls")

'Je sélectionne mes feuilles dans les fichiers
wk0.Sheets("Clos").Select
wk1.Sheets("Bidos").Select
wk1.Sheets("Non_Bidos").Select
wk1.Sheets("Clos_Priorites").Select

'Je sélectionne les colonnes/lignes/cellules qui m'intéressent
wk0.Sheets("Clos").Columns("A:A").Select
wk1.Sheets("Bidos").Columns("A:ZZ").Select
wk1.Sheets("Non_Bidos").Columns("A:ZZ").Select

'Je fais une double boucle pour comparer chaque valeur de la colonne A
'de "A_Valider_Calcul/Clos" avec chaque valeur de la colonne A de "Priories/Bidos ou Non_Bidos"

For i = 1 To 1000
For j = 1 To 1000
If wk0.Sheets("Clos").Cells(j, 1) = wk1.Sheets("Bidos").Cells(i, 1) Then wk1.Sheets("Bidos").Range("Ai:ZZi").Select
' Cells(j,1) correspond bien à la cellule (ligne=i, colonne=1)?
'La je ne sais pas comment colorier la cellule en vert ni comment la déplacer dans la feuille "Priorites/Clos_Priorites"

'Je me place sur la 1ère ligne vide de la feuille ou je veux déplacer la ligne
k = 1
wk1.Sheets("Clos_Priorites").Select
While Not Range("A" & k & "").Value = ""
k = k + 1
Wend
End If


If wk0.Sheets("Clos").Cells(j, 1) = wk1.Sheets("Non_Bidos").Cells(i, 1) Then wk1.Sheets("Non_Bidos").Range("Ai:ZZi").Select

k = 1
wk1.Sheets("Clos_Priorites").Select
While Not Range("A" & k & "").Value = ""
k = k + 1
Wend

End If
Next
Next

End Sub



Encore merci pour votre contibution.
 

Dranreb

XLDnaute Barbatruc
Re : VBA : Comparer cellules+ déplacer lignes

Bonjour
Les Select sont inutiles.
La double boucle n'est pas bonne: si vous coupez la ligne el la collez ailleurs son numéro de ligne utilisé comme compteur de boucle sera incrémenté à tort. il vaux mieux y rechercher la correspondance par WorksheetFunction.Match

Votre procédure pourrait ressembler à ça, encore qu'elle pourrait être plus lisible en utilisant des variables As Worksheet:
VB:
Sub Macro()
Dim i As Long, j As Long, k As Long, wk0 As Workbook, wk1 As Workbook 'Je définis mes variables

Workbooks.Open "C:\A_Valider_Calcul.xls"
Set wk0 = ActiveWorkbook
On Error Resume Next
Set wk1 = Workbooks("Priorites.xls")
If Err Then
   Workbooks.Open Priorites:="C:\Priorites.xls"
   Set wk1 = ActiveWorkbook
   End If
On Error GoTo 0

   
For j = 1 To 1000
   Do
      On Error Resume Next
      i = WorksheetFunction.Match(wk0.Worksheets("Clos").Cells(j, 1).Value, wk1.Worksheets("Non Bidos").Columns(1), 0)
      If Err Then i = 0
      On Error GoTo 0
      If i = 0 Then Exit Do
      wk1.Worksheets("Bidos").Cells(i, 1).Interior.Color = RGB(0, 255, 0)
      wk1.Worksheets("Bidos").Rows(i).Cut
      With wk1.WorkSheets("Clos_Priorites")
         With .UsedRange: k = .Row + .Rows.Count - 1
         .Rows(k).Insert
        End With
      Loop
   Next j
End Sub
Il vaut mieux utiliser Worksheets qui est une collection d'objets Workheet
plutôt que Sheets qui est une collection d'objets banalisés pouvant être de type Chart ou Worksheet.
Vérifiez si j'ai pris les bons wk.. et nom de feuilles: je m'y perd complètement dans vos noms qui ne me parlent pas du tout.
À+
 
Dernière édition:

CedricBDO

XLDnaute Nouveau
Re : VBA : Comparer cellules+ déplacer lignes

J'aurais une petite question supplémentaire, lorsque la maccro exécute la commande suivante :

wk1.Worksheets("Bidos").Rows(i).Cut

et qu'ensuite tu l'insères dans l'autre feuille Comment puis-je faire pour supprimer la ligne vide qu'il reste alors dans la feuille initiale?

Merci encore
 

Discussions similaires

Statistiques des forums

Discussions
312 115
Messages
2 085 443
Membres
102 889
dernier inscrit
monsef JABBOUR