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

Macros et VBA Excel Discussion :

VBA pour remplacer VLOOKUP [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut VBA pour remplacer VLOOKUP
    Bonjour à tous,

    Je vous pose le contexte :
    * 1 fois par semaine, une collègue fait un extraction BO pour un avoir la "descente de portefeuille" (*) au format xls.
    * Pour les chantiers déjà existant, elle fait une recherchev qui pointe sur la "descente de portefeuille" de la semaine passée afin de récupérer des calculs déjà faits.
    * Pour les nouveaux chantiers, elle fait ses calculs.
    * Q. Comment applique-t-elle sa recherchev ?
    R. Elle copie sa formule sur la 1ère cellule concernée d'une colonne puis l'applique sur les cellules qui suivent dans la même colonne.

    C'est chronophage et elle doit faire cela sur plusieurs colonnes.
    Difficulté supplémentaire = le nombre de ligne de ce tableau n'est pas fixe ; cela varie selon les semaines.

    (*) descente de portefeuille = suivi des avancées chantiers basé sur un numéro de dossier


    J'aimerais lui faire gagner du temps de traitement et j'ai pensé à un script vba sauf que je suis une bille (ou une bite, c'est comme tu veux) (**)
    L'objectif de ce script est de :
    * aller chercher une valeur dans un autre fichier excel (colonne 32), là ou le numéro de chantier est le même (colonne 1) et l'appliquer sur la colonne 32 du nouveau fichier
    * appliquer cette recherche / application tant qu'un numéro de chantier existe en colonne 1 du nouveau fichier
    * une fois que toutes les valeurs sont appliquées, vider les cellules en erreur ou dont la valeur = 0


    Si vous pouviez m'apporter la solution sur un plateau d'argent, ce serait géantissime.
    A défaut, si vous pouviez m'aiguiller, je serai très heureux aussi


    Modification :
    J'ai oublié de préciser que j'ai fait un enregistrement macro comme suit :
    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
    Sub LYCOS()
    '
    ' LYCOS Macro
    '       RechercheV
    '            correspondance entre numero de dossier colonne A de la descente de portefeuille semaine passee et semaine en cours
    '            insertion des valeurs dans les colonnes AF AG et AG
    '            application jusqu'aux cellules ligne 400
    '
     
    '
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(RC[-31],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,32,FALSE),"""")"
        Range("AG10").Select
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(RC[-32],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,33,FALSE),"""")"
        Range("AH10").Select
        ActiveCell.FormulaR1C1 = _
            "=IFERROR(VLOOKUP(RC[-33],'D:\TESTDDP\Ancien\[DDPOLD.xls]descente de P'!R10C1:R400C37,34,FALSE),"""")"
        Range("AF10:AH10").Select
        Selection.AutoFill Destination:=Range("AF10:AH400"), Type:=xlFillDefault
    End Sub
    Cet enregistrement ne me satisfait pas dans le sens où il ne prend pas en compte les différences de nombres de lignes selon les fichiers ; il s'applique jusqu'à la ligne 400, que les lignes soient alimentées ou non.

    En plus, le fichier peut évoluer (ajout/suppr de colonnes) et je ne sais pas comment faire pour que la recherche se fasse par rapport à un nom de colonne au lieu des numérotations
    Par ex, le 1er IfError concerne la colonne 32 (AF, nommée ETUDE), le 2nd est pour la colonne 33 (AG, nommée EXE) et le dernier pour la colonne 34 (AH, nommée MARCHE)

  2. #2
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 251
    Points : 5 626
    Points
    5 626
    Par défaut
    Bonjour,

    Ne pourriez-vous pas mettre un petit fichier exemple avec quelques lignes données (3 suffiraient) ? Cela aiderait à bien comprendre le problème.

    Cordialement.

  3. #3
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Bonjour EricDgn

    Voici les 2 fichiers avec les colonnes sur lesquelles automatiser la recherchev :

    DESCENTE DE PORTEFEUILLE - Copie.xls = descente de portefeuille semaine S
    DDPOLD - Copie.xls = descente de portefeuille semaine S-1

    Le contenu des colonnes AF, AG et AH du fichier semaine S-1 doit être réinjecté dans les colonnes AF, AG et AH du fichier semaine S.
    Le point de liaison est le numéro de dossier (colonne A de chaque fichier)
    L'ordre d'affichage des numéros de dossier change (nouveau dossier, dossier clôt, etc.).

  4. #4
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 251
    Points : 5 626
    Points
    5 626
    Par défaut
    Bonjour,

    Une façon de faire pour inscrire les formules dans les 3 colonnes titrées "Etude", "Exe" et "Marches" en considérant que dans les 2 fichiers ces titres sont en ligne 1 et les données récupérées dans la première feuille du fichier mais il n'est pas obligé que les colonnes soient aux mêmes endroits.
    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
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    Option Explicit
     
    Sub Reprendre()
        Dim fd As Office.FileDialog, sFile As String
        Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
        Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
        Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
        Dim sFml As String
        '--- recherche n° colonnes dans feuille en cours
        kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0)
        kExe = Application.WorksheetFunction.Match("Exe", Range("1:1"), 0)
        kMar = Application.WorksheetFunction.Match("Marches", Range("1:1"), 0)
        nR = Range("A" & Rows.Count).End(xlUp).Row
        nR = nR - 1                         '--- dernière ligne n'est pas une donnée
        Debug.Print kEtu, kExe, kMar, nR    '--- pour info
        '--- sélection fichier antérieur
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Filters.Clear
            .Filters.Add "Fichiers Excel", "*.xls*", 1
            .Title = "Choisir un fichier Excel"
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path
            If .Show = True Then
                sFile = .SelectedItems(1)
                Debug.Print sFile
                Set wbData = Application.Workbooks.Open(sFile)
                Set wshData = wbData.Worksheets(1)
                Set fd = Nothing
            Else
                MsgBox "Annulé", , "Pour info"
                Set fd = Nothing
                Exit Sub
            End If
        End With
        '--- recherche n° colonnes dans wshData
        kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Range("1:1"), 0)
        kExeD = Application.WorksheetFunction.Match("Exe", wshData.Range("1:1"), 0)
        kMarD = Application.WorksheetFunction.Match("Marches", wshData.Range("1:1"), 0)
        Debug.Print kEtuD, kExeD, kMarD
        nRD = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
        nRD = nRD - 1       '--- la dernière ligne n'est pas une donnée
        '--- dénomination de la plage de recherche
        Set rData = wshData.Range(wshData.Cells(2, 1), wshData.Cells(nRD, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
        Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address
        sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
        Debug.Print sData
        wbData.Close
        '--- inscription formules
        sFml = "=IFERROR(VLOOKUP($A2," & sData & ", 000, FALSE),"""")"
        Cells(2, kEtu).Formula = Replace(sFml, "000", kEtuD)
        Cells(2, kEtu).Copy
        Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteFormulas
        Cells(2, kExe).Formula = Replace(sFml, "000", kExeD)
        Cells(2, kExe).Copy
        Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteFormulas
        Cells(2, kMar).Formula = Replace(sFml, "000", kMarD)
        Cells(2, kMar).Copy
        Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteFormulas
        '--- cloture
        Set rData = Nothing
        Set wshData = Nothing
        Set wbData = Nothing
        MsgBox "Formules inscrites.", , "Pour info"
    End Sub
    Cordialement.

  5. #5
    Membre éprouvé Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    575
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 575
    Points : 1 016
    Points
    1 016
    Par défaut
    Bonjour,

    Sur le principe ta demande est tout à fait faisable et tu as déjà une réponse.

    Je complète en précisant que l'utilisation des fonctions imbriquées index et equiv te donnera le même résultat que la fonction recherchev (et en plus tu pourras faire une recherche vers la gauche si besoin alors que recherchev ne va que vers la droite).

    Une question: tu demandes une macro pour insérer les formules et donc tu obtiens les formules insérées mais il est également possible de reporter directement les valeurs. Ainsi tu n'auras plus de recalculs interfichiers. Surtout que tes données sources sont des extractions cycliques donc l'utilisateur ne les modifie pas normalement donc il n'y a, du moins de mon point de vue, pas de raison de garder les formules. Tu serais gagnant à récupérer les valeurs uniquement.

  6. #6
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Bonjour EricDgn et Alex020181,

    1000 pardons pour le délai de réponse, je comptais faire cela ce weekend et puis c'est passé trop vite.
    Bref...

    @EricDgn, merci beaucoup pour votre proposition ! Je vais décrypter puis tester votre solution [elle est à des années-lumière de ma compréhension du vba, je vais prendre mon temps pour la comprendre ]. Je vous ferai un retour courant de cette semaine.

    @Alex020181, oui tout à fait ; ce serait plus pertinent de récupérer directement les valeurs. D'autant plus qu'un "copier - coller valeur" est appliqué manuellement par ma collègue une fois l'extraction faite. J'avais enregistré en macro la manoeuvre mais je n'y ai pas trouvé de valeur ajoutée par rapport à la méthode manuelle car à chaque fois il s'agit d'un nouveau fichier généré donc il faut insérer la macro. En l'insérant le bout de code généré par l'enregistrement dans une macro globale, il y a une vraie valeur ajoutée (ou alors il existe une fonction vba pour cela ; mais je ne l'ai pas trouvé, et les 2-3 solutions que j'ai regardé sur le web ne m'ont pas vraiment convaincu... et je n'ai clairement pas approfondi le sujet).

  7. #7
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 251
    Points : 5 626
    Points
    5 626
    Par défaut
    Bonjour,

    Si seules les valeurs vous intéressent, il faut ajouter qq lignes pour copier - coller les valeurs (xlPasteVlues).
    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
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    Option Explicit
     
    Sub Reprendre()
        Dim fd As Office.FileDialog, sFile As String
        Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
        Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
        Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
        Dim sFml As String
        '--- recherche n° colonnes dans feuille en cours
        kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0)
        kExe = Application.WorksheetFunction.Match("Exe", Range("1:1"), 0)
        kMar = Application.WorksheetFunction.Match("Marches", Range("1:1"), 0)
        nR = Range("A" & Rows.Count).End(xlUp).Row
        nR = nR - 1                         '--- dernière ligne n'est pas une donnée
        Debug.Print kEtu, kExe, kMar, nR    '--- pour info
        '--- sélection fichier antérieur
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Filters.Clear
            .Filters.Add "Fichiers Excel", "*.xls*", 1
            .Title = "Choisir un fichier Excel"
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path
            If .Show = True Then
                sFile = .SelectedItems(1)
                Debug.Print sFile
                Set wbData = Application.Workbooks.Open(sFile)
                Set wshData = wbData.Worksheets(1)
                Set fd = Nothing
            Else
                MsgBox "Annulé", , "Pour info"
                Set fd = Nothing
                Exit Sub
            End If
        End With
        '--- recherche n° colonnes dans wshData
        kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Range("1:1"), 0)
        kExeD = Application.WorksheetFunction.Match("Exe", wshData.Range("1:1"), 0)
        kMarD = Application.WorksheetFunction.Match("Marches", wshData.Range("1:1"), 0)
        Debug.Print kEtuD, kExeD, kMarD
        nRD = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
        nRD = nRD - 1       '--- la dernière ligne n'est pas une donnée
        '--- dénomination de la plage de recherche
        Set rData = wshData.Range(wshData.Cells(2, 1), wshData.Cells(nRD, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
        Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address
        sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
        Debug.Print sData
        wbData.Close
        '--- inscription formules
        sFml = "=IFERROR(VLOOKUP($A2," & sData & ", 000, FALSE),"""")"
        '--- dans Etude
        Cells(2, kEtu).Formula = Replace(sFml, "000", kEtuD)
        Cells(2, kEtu).Copy
        Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteFormulas
        Range(Cells(2, kEtu), Cells(nR, kEtu)).Copy
        Range(Cells(2, kEtu), Cells(nR, kEtu)).PasteSpecial xlPasteValues
        '--- dans Exe
        Cells(2, kExe).Formula = Replace(sFml, "000", kExeD)
        Cells(2, kExe).Copy
        Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteFormulas
        Range(Cells(2, kExe), Cells(nR, kExe)).Copy
        Range(Cells(2, kExe), Cells(nR, kExe)).PasteSpecial xlPasteValues
        '--- dans Marche
        Cells(2, kMar).Formula = Replace(sFml, "000", kMarD)
        Cells(2, kMar).Copy
        Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteFormulas
        Range(Cells(2, kMar), Cells(nR, kMar)).Copy
        Range(Cells(2, kMar), Cells(nR, kMar)).PasteSpecial xlPasteValues
        '--- cloture
        Set rData = Nothing
        Set wshData = Nothing
        Set wbData = Nothing
        MsgBox "Valeurs inscrites.", , "Pour info"
    End Sub
    Cordialement.

  8. #8
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Merci beaucoup pour cet ajout EricDgn.

    J'ai testé votre script en l'état et j'ai une erreur d'exécution.

    Pour débogage, voici la numérotation des lignes pour votre code :
    ligne 1 = Sub Reprendre(),
    ligne 72 = End Sub.

    Durant le test, j'ai eu l'erreur 1004 à partir de la
    ligne 8 = kEtu = Application.WorksheetFunction.Match("Etude", Range("1:1"), 0).

    J'ai remplacé Range("1:1") sur 6 lignes comme suit :
    ligne 8 = Range("AF9:AF400"),
    ligne 9 = Range("AG9:AG400"),
    ligne 10 = Range("AH9:AH400"),
    ligne 35 = Range("AF9:AF400"),
    ligne 36 = Range("AG9:AG400"),
    ligne 37 = Range("AH9:AH400"),
    "9" car les titres des colonnes sont sur ligne 9 du fichier Excel.

    Cela passe.
    J'arrive à la fenêtre demandant le fichier antérieur et pointe vers l'ancien fichier.

    J'ai alors l'erreur 91
    variable objet ou variable bloc With non définie
    en ligne 26 = Set wshData = wbData.Worksheets(1).

    Sauriez-vous comment résoudre cela, svp ?

  9. #9
    Membre éprouvé Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    575
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 575
    Points : 1 016
    Points
    1 016
    Par défaut
    Bonjour Olivier,

    Voici en PJ une proposition de code pour répondre à ta demande.

    Nom : mod op.png
Affichages : 151
Taille : 63,0 Ko

    Il te suffit de compléter les titres à rechercher par fichier en B3:E4 puis de cliquer sur le bouton.
    2 fenêtres vont s'ouvrir successivement; il faudra naviguer dedans pour aller double cliquer d'abord sur le DDP old puis sur le DDP.

    Dans les 2 fichiers les feuilles concernées doivent être en première position.
    Dans les 2 fichiers les titres des colonnes doivent être en ligne 1.

    Les 2 fichiers DDP old et DDP ne doivent pas être ouverts.
    Par sécurité supplémentaire aucun autre fichier Excel que celui-ci ne doit être ouvert.

    Le nombre de lignes dans les 2 fichiers n'a pas d'importance.

    Teste et dis nous.
    Fichiers attachés Fichiers attachés

  10. #10
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 251
    Points : 5 626
    Points
    5 626
    Par défaut
    Bonjour,

    Oui, il y a de multiples façons de faire, dont celle-ci, adaptée au cas où le tableau des données ne commence pas à la ligne 1, mais quand même en colonne A:
    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
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    Option Explicit
     
    Sub Reprendre()
        Dim fd As Office.FileDialog, sFile As String
        Dim wbData As Workbook, wshData As Worksheet, rData As Range, sData As String
        Dim kEtu As Long, kExe As Long, kMar As Long, nR As Long
        Dim kEtuD As Long, kExeD As Long, kMarD As Long, nRD As Long
        Dim sFml As String
        Dim kRow1 As Long, kRow2 As Long, kRow1D As Long, kRow2D As Long
        '--- recherche n° ligne des titres dans feuille courante
        '--- suppose titre "Numéro de dossier" en colonne A
        kRow1 = Application.WorksheetFunction.Match("Numéro de dossier", Range("A:A"), 0)
        '--- recherche n° colonnes dans feuille en cours
        kEtu = Application.WorksheetFunction.Match("Etude", Rows(kRow1), 0)
        kExe = Application.WorksheetFunction.Match("Exe", Rows(kRow1), 0)
        kMar = Application.WorksheetFunction.Match("Marches", Rows(kRow1), 0)
        kRow1 = kRow1 + 1                               '--- première ligne avec des données
        kRow2 = Range("A" & Rows.Count).End(xlUp).Row   '--- dernière ligne (qui n'est pas une donnée mais indique le nb de dossiers)
        kRow2 = kRow2 - 1                               '--- dernière ligne avec des données
        Debug.Print kRow1, kRow2, kEtu, kExe, kMar      '--- pour info
        '--- sélection du fichier antérieur
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Filters.Clear
            .Filters.Add "Fichiers Excel", "*.xls*", 1
            .Title = "Choisir un fichier Excel"
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path
            If .Show = True Then
                sFile = .SelectedItems(1)
                Debug.Print sFile
                Set wbData = Application.Workbooks.Open(sFile)
                Set wshData = wbData.Worksheets(1)
                Set fd = Nothing
            Else
                MsgBox "Annulé", , "Pour info"
                Set fd = Nothing
                Exit Sub
            End If
        End With
        '--- recherche n° ligne des titres dans wshData
        '--- suppose "Numéro de dossier" en colonne A
        kRow1D = Application.WorksheetFunction.Match("Numéro de dossier", wshData.Range("A:A"), 0)
        '--- recherche n° colonnes dans wshData
        kEtuD = Application.WorksheetFunction.Match("Etude", wshData.Rows(kRow1D), 0)
        kExeD = Application.WorksheetFunction.Match("Exe", wshData.Rows(kRow1D), 0)
        kMarD = Application.WorksheetFunction.Match("Marches", wshData.Rows(kRow1D), 0)
        kRow1D = kRow1D + 1                             '--- n° première ligne avec des données
        kRow2D = wshData.Range("A" & wshData.Rows.Count).End(xlUp).Row
        kRow2D = kRow2D - 1                             '--- n° dernière ligne avec des données
        Debug.Print kRow1D, kRow2D, kEtuD, kExeD, kMarD '--- pour info
        '--- dénomination de la plage de recherche
        Set rData = wshData.Range(wshData.Cells(kRow1D, 1), wshData.Cells(kRow2D, Application.WorksheetFunction.Max(kEtuD, kExeD, kMarD)))
        Debug.Print wbData.Path, wbData.Name, wshData.Name, rData.Address   '--- pour info
        sData = "'" & wbData.Path & "\[" & wbData.Name & "]" & wshData.Name & "'!" & rData.Address
        Debug.Print sData                               '--- pour info
        wbData.Close
        '--- inscription formules
        sFml = "=IFERROR(VLOOKUP($A" & kRow1 & "," & sData & ", 000, FALSE),"""")"
        '--- dans Etude
        Cells(kRow1, kEtu).Formula = Replace(sFml, "000", kEtuD)
        Cells(kRow1, kEtu).Copy                             '--- copie formules
        Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).PasteSpecial xlPasteFormulas
        Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).Copy  '--- copie résultats (valeurs)
        Range(Cells(kRow1, kEtu), Cells(kRow2, kEtu)).PasteSpecial xlPasteValues
        '--- dans Exe
        Cells(kRow1, kExe).Formula = Replace(sFml, "000", kExeD)
        Cells(kRow1, kExe).Copy                             '--- copie formules
        Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).PasteSpecial xlPasteFormulas
        Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).Copy  '--- copie résultats (valeurs)
        Range(Cells(kRow1, kExe), Cells(kRow2, kExe)).PasteSpecial xlPasteValues
        '--- dans Marche
        Cells(kRow1, kMar).Formula = Replace(sFml, "000", kMarD)
        Cells(kRow1, kMar).Copy                             '--- copie formules
        Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).PasteSpecial xlPasteFormulas
        Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).Copy  '--- copie résultats (valeurs)
        Range(Cells(kRow1, kMar), Cells(kRow2, kMar)).PasteSpecial xlPasteValues
        '--- cloture
        Set rData = Nothing
        Set wshData = Nothing
        Set wbData = Nothing
        MsgBox "Valeurs inscrites.", , "Pour info"
    End Sub
    A tester.
    Cordialement.
    Fichiers attachés Fichiers attachés

  11. #11
    Membre éprouvé Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    575
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 575
    Points : 1 016
    Points
    1 016
    Par défaut
    @Olivier
    "9" car les titres des colonnes sont sur ligne 9 du fichier Excel.
    Oups je n'avais pas vu ça. Tes fichiers commençaient en ligne 1 donc j'avais fait avec ça.

    Bon pas grave. Je t'ai fait une V2. Même principe que la V1: tu complètes le tableau en B3:F4 et tu cliques.
    Le tableau de paramètres te permet de définir les titres des colonnes et le numéro de la ligne des titres pour chaque fichier.

    Teste et dis nous.

    @Éric
    Attention avec la méthode copy/paste. Si tu fais comme ça l'utilisateur perd les données qu'il avait copié en mémoire. Cela pourrait être gênant.
    Je te conseille d'utiliser AutoFill pour étendre les formules puis zone.value = zone.value pour remplacer les formules par leur résultat. (voir PJ).
    C'est un conseil hein pas une critique
    Fichiers attachés Fichiers attachés

  12. #12
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 251
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 251
    Points : 5 626
    Points
    5 626
    Par défaut
    Bonjour,

    @Alex. J'avais d'abord utilisé Autofill, mais ayant observé qu'il y avait des lignes de données déjà formatées (colorées) j'ai finalement opté pour Copy - PasteSpecial qui conserve ces formats. Autofill les écrase pour mettre le formatage de la cellule de départ.
    Par contre je n'avais pas pensé à utiliser zone.Value = zone.Value. Bonne idée.

    Cordialement.

  13. #13
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Bonjour EricDgn et Alex020181.

    Tout d'abord, je vous remercie à nouveau pour votre aide fort appréciable.

    Effectivement, concernant le démarrage des colonnes, j'ai épuré le fichier mais je n'aurais pas dû supprimer les 8 1ères lignes... désolé.
    Pour la colorisation des cellules, ne pas les prendre en compte car c'est ma collègue qui fait sa colorisation pour s'y retrouver selon les avancées et retards des dossiers.

    Je pense que vous allez très -trop ?- loin dans les scripts.
    Je m'explique : J'ai créé un batch qu'elle exécute en début de semaine (je suis un peu plus à l'aise dans les commandes dos )

    Voici le batch:
    Code Batch : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    @ECHO OFF
    DEL /f /q "D:\TESTDDP\Ancien\DDPOLD.xls"
    COPY "D:\TESTDDP\DESCENTE DE PORTEFEUILLE.xls" "D:\TESTDDP\Ancien\"
    RENAME "D:\TESTDDP\Ancien\DESCENTE DE PORTEFEUILLE.xls" DDPOLD.xls
    MOVE "D:\TESTDDP\DESCENTE DE PORTEFEUILLE.xls" "D:\TESTDDP\Ancien\"
    set datejour=%date:~6,4%%date:~3,2%%date:~0,2%
    RENAME "D:\TESTDDP\Ancien\DESCENTE DE PORTEFEUILLE.xls" "DDP_%datejour%.xls"
    EXIT

    Description :
    * suppression du fichier DDPOLD.xls dans le dossier \Ancien
    * copie du fichier DESCENTE DE PORTEFEUILLE.xls dans le dossier \Ancien et renommage en DDPOLD.xls
    * déplacement du fichier DESCENTE DE PORTEFEUILLE.xls dans le dossier \Ancien et renommage en DDP_date_du_jour.xls

    Ensuite, elle génère le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO.
    Dans ce fichier, elle met à jour manuellement les colonnes AF, AG et AH.
    Comme il y a des dossiers qui reviennent chaque semaine, pour éviter la saisie manuelle elle applique une recherchev pointant vers le fichier \Ancien\DDPOLD.xls.
    Elle renseigne manuellement ces colonnes pour les nouveaux dossiers.

    La macro vba que je ne sais pas faire devrait tout automatiser pour :
    - Trouver la correspondance entre DESCENTE DE PORTEFEUILLE.xls et \Ancien\DDPOLD.xls pour remplir les colonnes AF, AG et AH selon le numéro de dossier référencé en colonne A
    - mettre à vide les cellules dont la valeur est à 0 dans les colonnes AF, AG et AH
    - copier-coller la valeur dans les colonnes AF, AG et AH pour enlever toute référence à des formules

    Remarque :
    - Le nombre de lignes et l'ordre d'apparition des numéros de dossiers (colonne A) sont variables.



    J'espère être plus clair pour vous éviter de perdre du temps


    Je ne sais pas si cela aide, mais en dernière précision, les emplacements de fichiers énoncés sont temporaires. Les emplacements réels sont plutôt du style "U:\10 Commerce\00 Chargées Commerce\Descentes de portefeuilles PS\"

  14. #14
    Membre éprouvé Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    575
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 575
    Points : 1 016
    Points
    1 016
    Par défaut
    C'est ce que fais mon code.

    - Elle complète le tableau de paramètres (qui peut être enregistré une fois complété pour les semaines suivantes pour ne pas avoir à le ressaisir encore une fois)
    - Elle clique sur le bouton
    - Elle va sélectionner son fichier DDP old contenant les données à reprendre (donc le fichier \Ancien\DDPOLD.xls) dans la première fenêtre
    - Elle va sélectionner son fichier DDP contenant les données à mettre à jour (donc le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO) dans la seconde fenêtre
    - Le code mouline
    - Le fichier DESCENTE DE PORTEFEUILLE.xls via sa requête SAP BO est mis à jour avec les données du fichier \Ancien\DDPOLD.xls

    Mon fichier est, si tu préfères, un outil qui permet de mettre à jour le fichier DESCENTE DE PORTEFEUILLE.xls en tierce partie. Il ne faut pas prendre son code pour le copier coller dans la DDP.

    Il faut l'utiliser juste après la création de l'extraction BO.

  15. #15
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    Septembre 2021
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Maine et Loire (Pays de la Loire)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2021
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Bonjour EricDgn et Alex020181.

    @Alex020181 = Yes, cela fonctionne "superbien"

    Un grand grand grand merci à vous 2

    Ma prochaine étape : décortiquer vos scripts pour bien les comprendre

  16. #16
    Membre éprouvé Avatar de Alex020181
    Homme Profil pro
    Prestataire informatique développeur d'application Excel, Access, VBA
    Inscrit en
    Juin 2012
    Messages
    575
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Essonne (Île de France)

    Informations professionnelles :
    Activité : Prestataire informatique développeur d'application Excel, Access, VBA

    Informations forums :
    Inscription : Juin 2012
    Messages : 575
    Points : 1 016
    Points
    1 016
    Par défaut
    Cool.

    Merci du retour. Tout le monde ne le fait pas.

    Bon courage si tu décides de décortiquer le code. Il n'est pas des plus simples pour commencer.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Toutes versions] Faire un zoom sur un controle en VBA pour remplacer le raccourcis clavier
    Par possible924 dans le forum VBA Access
    Réponses: 4
    Dernier message: 13/08/2019, 14h23
  2. VBA pour remplacer . par une ,
    Par jeffvb93 dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 10/08/2017, 17h57
  3. [XL-2002] Code VBA pour remplacer la fonction RECHERCHEV
    Par NoodleDS dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 24/07/2013, 10h58
  4. [XL-2007] Code VBA pour remplacer le contenu de cellules
    Par tomlapomme dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 25/08/2010, 15h39
  5. Réponses: 7
    Dernier message: 21/09/2006, 15h06

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