IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Excel Discussion :

Import données avec doublons potentiels, recopier des valeurs sur ces doublons


Sujet :

Excel

  1. #1
    Membre à l'essai
    Femme Profil pro
    Assistante Service Approvisionnement
    Inscrit en
    décembre 2015
    Messages
    43
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 51
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Assistante Service Approvisionnement
    Secteur : Industrie

    Informations forums :
    Inscription : décembre 2015
    Messages : 43
    Points : 19
    Points
    19
    Par défaut Import données avec doublons potentiels, recopier des valeurs sur ces doublons
    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

  2. #2
    Expert confirmé
    Homme Profil pro
    Electrotechnicien
    Inscrit en
    juillet 2016
    Messages
    3 151
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Electrotechnicien

    Informations forums :
    Inscription : juillet 2016
    Messages : 3 151
    Points : 5 512
    Points
    5 512
    Par défaut
    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

  3. #3
    Membre à l'essai
    Femme Profil pro
    Assistante Service Approvisionnement
    Inscrit en
    décembre 2015
    Messages
    43
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 51
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Assistante Service Approvisionnement
    Secteur : Industrie

    Informations forums :
    Inscription : décembre 2015
    Messages : 43
    Points : 19
    Points
    19
    Par défaut
    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

  4. #4
    Expert confirmé
    Homme Profil pro
    Electrotechnicien
    Inscrit en
    juillet 2016
    Messages
    3 151
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Electrotechnicien

    Informations forums :
    Inscription : juillet 2016
    Messages : 3 151
    Points : 5 512
    Points
    5 512
    Par défaut
    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

  5. #5
    Membre à l'essai
    Femme Profil pro
    Assistante Service Approvisionnement
    Inscrit en
    décembre 2015
    Messages
    43
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 51
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Assistante Service Approvisionnement
    Secteur : Industrie

    Informations forums :
    Inscription : décembre 2015
    Messages : 43
    Points : 19
    Points
    19
    Par défaut
    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

  6. #6
    Expert confirmé
    Homme Profil pro
    Electrotechnicien
    Inscrit en
    juillet 2016
    Messages
    3 151
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Electrotechnicien

    Informations forums :
    Inscription : juillet 2016
    Messages : 3 151
    Points : 5 512
    Points
    5 512
    Par défaut
    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.

Discussions similaires

  1. [MySQL] boucle en php avec retour des valeur sur smarty
    Par le nOoB dans le forum PHP & Base de données
    Réponses: 4
    Dernier message: 24/09/2011, 18h05
  2. Importer données avec la commande With ActiveSheet.QueryTables.Add
    Par hbc87 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 31/05/2010, 06h14
  3. [XL-2003] recopier des valeurs correspondant à une donnée
    Par spico45 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 02/02/2010, 12h51
  4. Réponses: 8
    Dernier message: 10/03/2009, 13h22
  5. Réponses: 5
    Dernier message: 10/12/2007, 16h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo