Correction cellules erronées par une Base

[wooguy]

Bonjour, mes connaissances en VBA ne sont que sommaire et je galère depuis un bon bout de temps pour trouver un code automatique pour effectuer la correction d’un fichier que je reçois toutes les semaines et qui est truffé de "### ".
J’ai 2 feuilles :
Données : (celle qui est à corriger) plus de 64000 lignes (références redondantes)
Base avec les bonnes infos) 150 lignes ~
Je cherche un code qui
1° détecte les "###" colonnes D ou G de la feuille (données) à partir de la ligne 2, prend en référence la cellule C de la ligne. Pour gagner du temps filtrer que les « ### » ????
2° chercher sur la feuille (base) colonne A la même référence que C (données) , SI OK, récupère les infos des cellules B (base),C (base) et G (base) .
3° corrige la ligne de la feuille (données) en remplaçant les cellules :
D (données) par B(base)
G(données) par C(base)
E(données) par G (base)

Est ce, jusqu'en bas de la feuille (données)

Merci de votre aide

 

[Jack2]

Re : Correction cellules erronées par une Base

Bonjour wooguy, Bonsoir Paf,

Mise à jour

Dans le fichier :
- Click 1 : procédure que je t'ai proposée
- Click 2 : le code de Paf

C'est la deuxième fois que je vois l'utilisation d'un Scipting dictionary. Ca semble efficace, j'ai plus qu'à apprendre. J'espère que wooguy trouveras ce qu'il cherche.

A+ Jack2

 

[Paf]

Re : Correction cellules erronées par une Base

Bonjour à tous,

un code utilisant un Scipting dictionary, permettant peut-être de gagner en performance.

les références de la feuille "données", inconnues dans la feuille "base", sont simplement listées dans un msgbox.

Sub Macro1()

Dim Derl As Long, DerlBase As Long, i As Long
Dim MonMsg As String, Compar As String
Dim Dico, TabBase

Set Dico = CreateObject("Scripting.Dictionary")

Derl = Worksheets("données").Range("A" & Rows.Count).End(xlUp).Row
DerlBase = Worksheets("base").Range("A" & Rows.Count).End(xlUp).Row

MonMsg = "Références non trouvées : " & vbLf

'******** Creation d' un "Dico" contenant les référence de la  base puis le N° de ligne (-1)  
TabBase = Worksheets("base").Range("A2:A" & DerlBase)
For i = LBound(TabBase) To UBound(TabBase)
    Dico(TabBase(i, 1)) = i
Next i
'** fin création Dico
  
'**** traitement des lignes Données
For i = 2 To Derl
    If Worksheets("données").Cells(i, 4) = "###" Or Worksheets("données").Cells(i, 7) = "###" Then
        Compar = Worksheets("données").Cells(i, 3)
        If Dico.Exists(Compar) Then
            Worksheets("données").Cells(i, 4) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 2)
            Worksheets("données").Cells(i, 7) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 3)
            Worksheets("données").Cells(i, 5) = Worksheets("base").Cells(Dico.Item(Compar) + 1, 7)
            Compt = Compt + 1
        Else
            MonMsg = MonMsg & "Ligne : " & i & " référence : " & Compar & vbLf
        End If
    End If
Next
'******* Fin Traitement
MsgBox Compt & "Références mises à jour " & vbLf & MonMsg
End Sub

bonne suite

 

[wooguy]

Re : Correction cellules erronées par une Base

Merci Paf, je fais les essais ce matin et te tiens au courant !!!!

 

[Jack2]

Re : Correction cellules erronées par une Base

Bonjour wooguy, Bonsoir Paf,

Pour wooguy, j'ai mis les deux codes dans le le post 1 (Essais correction 2.xls‎ ), y compris celui de Paf

A+ Jack2

 

[wooguy]

Re : Correction cellules erronées par une Base

bonsoir à tout les deux

merci pour l’intérêt que vous portez à mon problème .

J'ai essayé les deux codes:

entre temps j'ai mis les deux boutons sur une page vierge (Feuil1)

la macro (Macro 1 ) vas jusqu’au msgbox qui m'indique les références mises à jours et les références non trouvées, je fais OK, mais la correction sur la page (données) ne se fait pas.

La macro (Essais correction 2.xls‎) se met en erreur
Erreur d’exécution "1004"
erreur définie par l'application ou par l'objet !!
Sur cette ligne :

For i = 2 To Sheets("données").Range("A2", Range("A65535").End(xlUp)).Rows.Count

je vous joint le fichier !!

Merci encore

WOOGUY

 

[Paf]

Re : Correction cellules erronées par une Base

re,
dans le classeur du post #6, dans la feuille "données", les références restantes avec ### sont les références non trouvées dans la base. les autres sont corrigées .
Quand la MsgBox s'affiche, les références sont déjà mises à jour. le bouton OK ne sert qu'à quitter .

Relancé après copie des données de la feuille "données" du post #1, pas d'anomalies trouvées.

A+

 

[wooguy]

Re : Correction cellules erronées par une Base

Bonsoir !

J'ai mis une base plus importante (base), je fais les essais ce soir et je vous tiens au courant.

Merci encore pour le coup de main !!!

Wooguy

 

[Jack2]

Re : Correction cellules erronées par une Base

Bonsoir tout le monde,

Effectivement wooguy il vaut mieux remplacer la ligne

For i = 2 To Sheets("données").Range("A2", Range("A65535").End(xlUp)).Rows.Count

par celle de de Paf qui

For i = 2 To Worksheets("données").Range("A" & Rows.Count).End(xlUp).Row

Ou, toujours comme Paf définir une variable DerLig puis For i = 2 To DerLig

A+ Jack2

 

[Paf]

Re : Correction cellules erronées par une Base

effectivement, certaines références ne sont pas prises en comptes alors que ça fonctionne pour la majorité ?

Pas trouvé pourquoi, mais trouvé correction:

If Dico.Exists(Val(Compar)) Then
Pos = Dico.Item(Val(Compar)) + 1
Worksheets("données").Cells(i, 4) = Worksheets("base").Cells(Pos, 2)
Worksheets("données").Cells(i, 7) = Worksheets("base").Cells(Pos, 3)
Worksheets("données").Cells(i, 5) = Worksheets("base").Cells(Pos, 7)
Compt = Compt + 1
Else
...

et, chose importante omise, à mettre avant le End Sub:

Set Dico = Nothing qui permet de libérer la mémoire allouée à Dico

Bonne suite

 

[wooguy]

Re : Correction cellules erronées par une Base

Bonsoir !!!

Tout est ok , pour les deux codes !

Grand remerciement !!!

Petite intervention, pouvez vous effacer de:
Type de fichier : xls Essais correction 2.xls‎ (139,5 Ko, 8 affichages)
la page (base) j'ai OUPPSSSS des infos.

Merci pour tout

WOOGUY

 

[Jack2]

Re : Correction cellules erronées par une Base

Bonjour WOOGUY,
C'est fait
A+ Jack2

 

[Jack2]

Re : Correction cellules erronées par une Base

Bonjour tout le monde (surtout WOOGUY),

Dans le code que j'avais donné, je faisais toute une gymnastique pour trouver la ligne à modifier alors qu'elle est
donnée par la valeur de Cel.Row, ce qui permet d'enlever plein de lignes inutiles.

Sub Transfert(Lig As Long, i As Long)
    Sheets("données").Range("D" & i).Value = Sheets("base").Range("B" & Lig)
    Sheets("données").Range("G" & i).Value = Sheets("base").Range("C" & Lig)
    Sheets("données").Range("E" & i).Value = Sheets("base").Range("G" & Lig)
End Sub

Sub Essais_Correction()
Dim Cel As Range
Dim Référence As String
Dim i As Long
Application.ScreenUpdating = False
For i = 2 To Worksheets("données").Range("A" & Rows.Count).End(xlUp).Row
  Sheets("données").Select
  If (Sheets("données").Range("D" & i).Value = "###") Or (Sheets("données").Range("G" & i).Value = "###") Then
      Référence = Sheets("données").Range("C" & i).Value
      Set Cel = Sheets("base").Range("A:A").Find(Référence, , xlValues, xlWhole, , , False)
      If Not Cel Is Nothing Then Transfert Cel.Row, i
  End If
Next i
Application.ScreenUpdating = True
End Sub

C'est long l'apprentissage !
Jack2