Discussion :

[Fleur59]

Bonjour à tous,
Je n'ai pas trouvé un code à adapter dans les forums, je me tourne vers vos têtes bien faites toujours en ébullition.
J'importe au quotidien des données avec des doublons potentiels. Je balaye les anciennes données et reporte, quand elles existent, les valeurs de 3 colonnes sur les doublons des nouvelles données.
J'utilise un "find" & "lookin" dans une boucle, mais c'est beaucoup trop long!!
Mes doublons se trouvent en colonne C, les données à copier en N,O et P
Une idée pour assainir et rendre plus rapide cette partie?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub CopyDatas()
 
Application.Calculation = xlManual
 
    'Copie des réponses sur nouveaux
Sheets("TaskMaint").Select
nl = Range("B65536").End(xlUp).Row
nlg = Range("A65536").End(xlUp).Row
 
For o = nlg + 1 To nl
 
    YK = Range("C" & o).Value
 
                '  cherche YK
    Dim x As Range
    Dim firstAddress As String
 
    Sheets("TaskMaint").Activate
    With Worksheets("TaskMaint").Range("C2:C" & nl)
        Set x = .Find(YK, LookIn:=xlValues)
        If Not x Is Nothing Then
            firstAddress = x.Address
    'Cy = Range(firstAddress).Column   ' Pour la colonne
 
    'Do
            Cx = Range(x.Address).Row  ' Pour la ligne
 
                Range("N" & o) = Range("N" & Cx)
                Range("O" & o) = Range("O" & Cx)
                Range("P" & o) = Range("P" & Cx)
                Range("Q" & o) = Range("Q" & Cx)
 
    'Loop While Not x Is Nothing And x.Address <> firstAddress
         End If
         End With
Next o
 
Application.Calculation = xlAutomatic
 
End Sub

Merci de votre aide par avance
Fleur

[ARTURO83]

Bonjour,

Sans avoir une vue du fichier, difficile de se projeter et de proposer un code correct et performant, il y a des points à éclaircir, pourquoi nl et nlg ?
Voici une proposition qui pourrait se rapprocher de se que vous voulez faire, à adapter selon la configuration de votre fichier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub CopyDatas()
    Dim nl As Long, nlg As Long, o As Long, Lig_YK As Long
    Dim YK As String
    Application.ScreenUpdating = False
    nl = Range("B" & Rows.Count).End(xlUp).Row
    nlg = Range("A" & Rows.Count).End(xlUp).Row
    For o = 2 To nl
        On Error Resume Next
        YK = Range("C" & o).Value
        Lig_YK = Application.Match(YK, Range("C1:C" & nl), 0) 'ligne de YK recherché
        If Lig_YK <> 0 Then Range(Cells(o, "N"), Cells(o, "Q")).Value = Range(Cells(Lig_YK, "N"), Cells(Lig_YK, "Q")).Value        'Copie des réponses sur nouveaux
        On Error GoTo 0
    Next o
End Sub

Cdlt

[Fleur59]

Bonjour Arturo83,
Explication des nl et nlg: Lorsque j'importe mes données elles sont copiées à partir de la colonne B, un statut est mis en place en fin de traitement en colonne A.
Donc, avant traitement du statut, je viens relever ma dernière valeur de la veille et ma dernière valeur du jour (en nombre de ligne), je viens seulement tester mes nouvelles valeurs, avec doublons potentiels, sur les anciennes valeurs.

Merci pour cette idée, je viens de la tester, cela marche bien pour les 2 Premières lignes, puis ça me recopie l'information sur des lignes qui ne sont pas des doublons!
Je mets le fichier en pièce jointe
Merci d'avance
Class1.7z
Fleur

[ARTURO83]

Bonjour,

Au vu de l'explication que vous donnez sur nl et nlg, je pense que l'erreur vient de cette ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    If Lig_YK <> 0 Then Range(Cells(o, "N"), Cells(o, "Q")).Value = Range(Cells(Lig_YK, "N"), Cells(Lig_YK, "Q")).Value       'Copie des réponses sur nouveaux

il faut comparer la valeur de Lig_YK avec "o" et non pas "0", ce qui donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Lig_YK <> o Then Range(Cells(o, "N"), Cells(o, "Q")).Value = Range(Cells(Lig_YK, "N"), Cells(Lig_YK, "Q")).Value       'Copie des réponses sur nouveaux

A vérifier de votre côté.

Autre remarque, visiblement vous devez faire des "copiés-collés" de feuilles entières, votre feuille "TaslMaint" bien que ne contenant qu'un peu plus de 2000 lignes se comporte comme si elle était pleine, ce qui à pour effet de ralentir l'exécution des codes. J'ai été obligé d'en créer une autre et de n'y copier que les lignes nécessaires et non pas la feuille entière, dès lors, le code s'exécute beaucoup plus rapidement. Je vous conseille vivement pour le prochaines fois de ne copier-coller que les données réelles et non pas la feuille entière. Autre preuve votre fichier pesait 60029Ko, il ne fait plus que 576Ko, soit 100 fois moins gros.

Fleur59_Import données avec doublons potentiels, recopier des valeurs sur ces doublons.xlsm

Cdlt

[Fleur59]

Bonjour Arturo83
J'ai corrigé votre code comme demandé (0 par o) mais rien ne change
la valeur recopiée reste figée à la valeur du premier doublon détecté (ligne 332)
J'ai pu obtenir le résultat attendu en remplaçant le qualifiant de Lig_YK (Long) par un variant
"Dim nl As Long, nlg As Long, o As Long, Lig_YK As Variant"

Je continue à tester et reviendrai vers vous pour la résolution ou une suite
Merci pour ce gain de temps

Fleur

[ARTURO83]

J'ai pu obtenir le résultat attendu en remplaçant le qualifiant de Lig_YK (Long) par un variant en double si vous voulez mais pas en variant.



La recherche doit se faire avec nl et non nlg: Lig_YK = Application.Match(YK, Range("C2:C" & nl), 0) 'ligne de YK recherché.

Essayez.

[Fleur59]

Bonjour à tous
Merci Arturo
Vos réponses pertinentes m'ont permis de passer moins de temps
Bon courage à tous
Je pose ce point en résolu
Fleur