Macro pour comparer des feuille excel identiques

Rayy87 Messages postés 32 Statut Membre -  
Rayy87 Messages postés 32 Statut Membre -
Bonjour à tous,
Je suis nouveau dans ce forum et débutant en VBA.

J'ai des fichiers excel ( même feuille qui est dupliquée 200 fois) et qui contiennent tous des données différentes (des renseignements de prix).

J'aimerais trouver uine macro qui pourra analyser les feuilles une par une et me classer les prix du moins cher au plus cher.
Sachant que je vais séléctionner les cellules à comparer.

J'ai quelques idées, donc pour commencer j' utilise une application.dialog qui me permet de selectionner les fichiers excel à comparer.
Ensuite avec un Do while fichier >0
Workbook.open
for each feuille in workbook.worksheets
et là je bloque ...

Pourriez vous m'aider svp?

------------ 

Sub Compare()

Dim cell1, cell2, cell3, cell4 As Integer (mes cellules à comparer que je vais nommer)
Dim lockcode As String
Dim Repeat As String

Dim Dialog As Office.FileDialog
Dim fPath As String, fName As String, OldDir As String
Dim ws As Worksheet
Dim Ans As String


If MsgBox("LANCEMENT DE L'APPLICATION D'ANALYSE", vbOK, "ACCES ADMINISTRATEUR") Then




        lockcode = InputBox("Veuillez saisir votre mot de passe administrateur", "FENÊTRE DE CONTRÔLE", vbOKCancel)
        
        
        If lockcode = ("Admin") Then
        
        Set Dialog = Application.FileDialog(msoFileDialogFilePicker)

                         With Dialog
                              .AllowMultiSelect = True
                              .ButtonName = "Valider"
                              .Filters.Clear
                              .Filters.Add "Excel Files", "*.xls;*.xlw, 1"
                              .Filters.Add "Excel Files", "*.xlsx*, 1"
                              .Filters.Add "Excel Files", "*.xlsm*, 1"

    
                              .Title = "Veuillez selectionner les fichiers à analyser"
                              .InitialFileName = "C:\InitialPath\"
                              .InitialView = msoFileDialogViewList
(là j'arrive pas à faire fonctionner la macro uniquement sur les fichiers sélectionnés)
                                If .Show Then
                                If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
    
   
  Ans = Application.InputBox("Voulez-vous lancer l'analyse des classeurs?" & vbLf & vbLf & _
                                 "Saisissez OUI - pour démarrer" & vbLf & "ou NON - pour quitter l'application", "Choix de l'action à effectuer", Type:=1)
                                    If Ans = "OUI" Then MsgBox "l'analyse est en cours, veuillez patienter"
                                    
                                    
   
                                     
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

    'OldDir = CurDir
   ' ChDir fPath
    fName = Dir("*.xls")

    
                Do While Len(fName) > 0
                                        Workbooks.Open fName
                                        For Each ws In ActiveWorkbook.Worksheets
                                        Range("Cell1").select
// là je sais plus :(
                           



             
              Next ws
        ActiveWorkbook.Close True
        fName = Dir
        Cnt = Cnt + 1
    Loop


            Application.ScreenUpdating = True
            Application.DisplayAlerts = True
            Application.EnableEvents = True
            MsgBox Cnt & "  fichiers ont été traités."
            

Exit Sub
Else: MsgBox "Le mot de passe saisi est incorrect"
End If


End With
End If
End If

End Sub
End Sub

6 réponses

Résumé de la discussion

La problématique consiste à créer une macro VBA capable d’ouvrir plusieurs classeurs Excel, d’analyser chaque feuille et de classer les prix du moins cher au plus cher selon des cellules à comparer. Des solutions proposées utilisent un FileDialog multisélection pour choisir les classeurs, puis ouvrent chaque fichier, parcourent les feuilles et stockent les valeurs clés dans un tableau avant de les transférer. Le schéma type prévoit une boucle For Each sur les feuilles, une structure Tbl et Option Explicit pour manipuler le lot, le nom et le montant. En complément, il faut ignorer les feuilles non pertinentes et prévoir une gestion d’erreurs pour la robustesse.

Généré automatiquement par IA
sur la base des meilleures réponses
  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    Regarde cette astuce : https://www.commentcamarche.net/faq/32961-vba-excel-lire-dans-un-classeur-ferme
    et notamment l'exemple d'utilisation...
    1
  2. Rayy87 Messages postés 32 Statut Membre
     
    Merci, c'est tout à fait ce qu'il me faut.
    Je vais essayer d'adapter le code et je te dirais :)
    Merci encore!
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Pas de souci.
      N'hésite pas!
      @+
      0
    2. Rayy87 Messages postés 32 Statut Membre
       
      Bonjour :)

      En fait il me manques un truc.. Je veux définir une variable dans laquelle je mets une zone qui contient le n° d'un article. Et en gros ma macro doit vérifier que c'est le même numéro d'article déjà puis copier les différents prix et les coller dans une nouvelle feuille/nouveau classeur classés par n° de produit.

      Donc je pense faire For each Feuille in activeWorkbook.worksheets (j'ai fait une macro qui ouvre tout les classeurs contenus dans le fichier) puis with Active.workbook.sheets(i)
      If sheets.range("C3") c'est la cellule qui contient le n° du produit...

      Comment est ce que je peux dire si le N° produit est le même dans toutes les feuilles?

      Sachant que j'ai 200 produits donc je peux pas faire une boucle si nom produit= x, il me faut une boucle.

      Je ne sais pas si je suis clair...
      0
    3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Je ne sais pas si je suis clair...

      Ben non.
      Je n'ai pas compris ce que tu souhaites...
      0
    4. Rayy87 Messages postés 32 Statut Membre
       
      Désolé...
      Comment je fais pour joindre des fichiers ici? Comme ça ça illustre plus ce que je veux dire..
      0
    5. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Il faut passer par un site de pièce jointe tel que https://www.cjoint.com/

      Va sur ce site,
      Clic sur parcourir
      Cherche ton fichier
      clic sur ouvrir
      Clic sur "Créer le lien cjoint"
      Copier le lien
      Revenir ici le coller dans une réponse...
      0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    teste déjà ceci : 

    'déclaration des variables
Dim ws As Worksheet
Dim i As Integer
Dim Tbl()

'blablabla
'ton début de code ici
'la boucle sur toutes les feuilles du classeur ouvert
For Each ws In ActiveWorkbook.Worksheets
  With ws
    If .Range("T6").Value <> 0 Then
      i = i + 1
      ReDim Preserve Tbl(1 To 3, 1 To i)
      Tbl(2, i) = .Range("C3") 'n° lot
      Tbl(1, i) = .Range("D6") 'Nom entreprise
      Tbl(3, i) = .Range("T6") 'montant global
    End If
  End With
Next
'blabla
'classeur suivant
'etc
'restitution des données récoltées dans la Feuil1 du classeur analyse
'!!!!Attention analyse.xslx devient analyse.xlsm puisque tu y enregistres cette macro
MsgBox Cnt & "  fichiers ont été traités."
Workbooks("analyse_des_offres.xlsm").Sheets("Feuil1").Range("A2").Resize(UBound(Tbl, 2), 3) = Application.Transpose(Tbl)

    0
  4. Rayy87 Messages postés 32 Statut Membre
     
    J'arrive pas à compiler :(

    Les .range ne marchent du coup j'ai mis ws.range vu que ws c'est la variable qui contient le classeur ouvert nn?

    https://www.cjoint.com/?3FmpM03hiSU
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Les .range ne marchentpas.
      As tu bien mis, avant les .range With ws et après End With?

      Sinon, tu peux mettre ws.Range sans souci, c'est la même chose...
      0
    2. Rayy87 Messages postés 32 Statut Membre
       
      J'ai tester, j'ai plus d'erreur par contre ça ne fait rien :(

      Une fenêtre s'ouvre bien et je séléctionne les fichiers à traiter, puis rien ...
      Tu peux jetter un coup d'oeil stp?

      https://www.cjoint.com/?3Fmp37yxkNu
      0
    3. Rayy87 Messages postés 32 Statut Membre
       
      Suis bête,
      donc là pour l'instant on a sauvegarder les valeur dans un tableau.
      Il faut ensuite les copier dans les cellules dans le fichier analyse, non?
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      avec les fichiers que tu m'as transmis, j'ai essayé le code donné plus haut, il fonctionne.

      Je te le remets ici, avec tes propres codes intégrés... 
      Option Explicit

Sub Test()
Dim lockcode As String
Dim Dialog As Office.FileDialog
Dim Repeat As String
Dim fPath As String, fName As String, OldDir As String
Dim Cnt As Long
Dim cell1, cell2, cell3, cell4 As Boolean
Dim ligne As Integer
Dim colonne As Integer
Dim Chemin As String, Fichier As String
Dim i As Integer
Dim ws As Worksheet
Dim Tbl()

Chemin = "D:\8710839D\Desktop\Analyse"
Fichier = "Analyse_des_offres.xlsm"
If MsgBox("LANCEMENT DE L'APPLICATION D'ANALYSE", vbOK, "ACCES ADMINISTRATEUR") Then
    lockcode = InputBox("Veuillez saisir votre mot de passe administrateur", "FENÊTRE DE CONTRÔLE", vbOKCancel)
    If lockcode = ("AdminXXXX") Then
        Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
        With Dialog
            .AllowMultiSelect = True
            .ButtonName = "Valider"
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls;*.xlw, 1"
            .Filters.Add "Excel Files", "*.xlsx*, 1"
            .Filters.Add "Excel Files", "*.xlsm*, 1"
            .Title = "Veuillez selectionner les fichiers à traiter"
            .InitialFileName = "C:\InitialPath\"
            .InitialView = msoFileDialogViewList
            If .Show Then
                If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
                Do While Len(fName) > 0
                    Workbooks.Open fName
                    For Each ws In ActiveWorkbook.Worksheets
                        If ws.Name <> ("Lisez moi") Then
                            If ws.Name <> ("Paramètres") Then
                                With ws
                                    If .Range("T6").Value <> 0 Then
                                        i = i + 1
                                        ReDim Preserve Tbl(1 To 3, 1 To i)
                                        Tbl(2, i) = .Range("C3")
                                        'n° lot
                                        Tbl(1, i) = .Range("D6")
                                        'Nom entreprise 
                                        Tbl(3, i) = .Range("T6")
                                        'montant global
                                    End If
                                End With
                            End If
                        End If
                    Next ws
                    ActiveWorkbook.Close True
                    fName = Dir
                   Cnt = Cnt + 1
               Loop
           End If
           MsgBox Cnt & "  fichiers ont été traités."
           Workbooks("analyse_des_offres.xlsm").Sheets("Feuil1").Range("A2").Resize(UBound(Tbl, 2), 3) = Application.Transpose(Tbl)                    
        End With
    End If
End If


End Sub


      Je l'ai pas mal modifié, mais teste pour voir
      0
    5. Rayy87 Messages postés 32 Statut Membre
       
      ça me met "l'indice n'appartient pas à la selection".
      C'est donc que un des fichiers n'est pas dans le bon endroit ou n'as pas le bon nom présent dans le code?
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Essaye comme ceci : 
    Sub Compare()
Dim lockcode As String 'Mot de passe
Dim Dialog As Office.FileDialog 'Boite de dialogue sélection de fichiers
Dim Cptr As Integer 'Nombre de fichiers traités
Dim ws As Worksheet 'Feuilles
Dim Tbl() 'Variable tableau de recueil des données
Dim i As Long 'indentation de la variable tableau Tbl()

If MsgBox("LANCEMENT DE L'APPLICATION D'ANALYSE", vbOK, "ACCES ADMINISTRATEUR") Then
    lockcode = InputBox("Veuillez saisir votre mot de passe administrateur", "FENÊTRE DE CONTRÔLE", vbOKCancel)
    If lockcode = ("Admin") Then
        Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
        With Dialog
            .AllowMultiSelect = True
            .ButtonName = "Valider"
            .Filters.Clear
            .Filters.Add "Excel Files", "*.xls;*.xlw, 1"
            .Filters.Add "Excel Files", "*.xlsx*, 1"
            .Filters.Add "Excel Files", "*.xlsm*, 1"
            .Title = "Veuillez selectionner les fichiers à analyser"
            .InitialFileName = "C:\InitialPath"
            .InitialView = msoFileDialogViewList
            .Show
            For Cptr = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
                Workbooks.Open Application.FileDialog(msoFileDialogFilePicker).SelectedItems(Cptr)
                For Each ws In ActiveWorkbook.Worksheets
                    If ws.Name <> ("Lisez moi") Then
                        If ws.Name <> ("Paramètres") Then
                            With ws
                                If .Range("T6").Value <> 0 Then
                                    i = i + 1
                                    ReDim Preserve Tbl(1 To 3, 1 To i)
                                    Tbl(2, i) = .Range("C3")
                                    'n° lot
                                    Tbl(1, i) = .Range("D6")
                                    'Nom entreprise
                                    Tbl(3, i) = .Range("T6")
                                    'montant global
                                End If
                            End With
                        End If
                    End If
                Next ws
                ActiveWorkbook.Close True
            Next
            MsgBox Cptr & " fichiers ont été traités."
            Workbooks("analyse_des_offres.xlsm").Sheets("Feuil1").Range("A2").Resize(UBound(Tbl, 2), 3) = Application.Transpose(Tbl)
        End With
    End If
End If
End Sub


    Cordialement,
    Franck
    0
  7. Rayy87 Messages postés 32 Statut Membre
     
    C'est bon j'ai utilisé

    Sheets(str_Onglet).Range("H39:P" & long_DerniereLigne).Select
    Sheets(str_Onglet).Rows(str_RowsPaste).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    Et ça marche du coup :)))

    Par contre une autre question.... J'arrive pas à faire marcher cette imbrication

    =SI(I36>0;SI(ESTVIDE(H36));SI(estvide(h37));si(estvide(h38));si(estvide(h39));si(estvide(h40));si(estvide(h41));"Veuillez renseigner les champs-> ";"")

    Je ne veux pas utiliser de vba dans ce fichier... Tu as une autre solution?
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      deux choix comme je ne sais pas ce que tu veux faire :

      =SI(I36>0;SI(OU(ESTVIDE(H36);ESTVIDE(H37);ESTVIDE(H38);ESTVIDE(H39);ESTVIDE(H40);ESTVIDE(H41));"Veuillez renseigner les champs-> ";"");"valeur si I36<0")

      ou

      =SI(I36>0;"valeur si I36>0";SI(OU(ESTVIDE(H36);ESTVIDE(H37);ESTVIDE(H38);ESTVIDE(H39);ESTVIDE(H40);ESTVIDE(H41));"Veuillez renseigner les champs-> ";""))
      0
    2. Rayy87 Messages postés 32 Statut Membre
       
      Génial, ça a marché.
      En fait je veux que tant que une de ces cellules sont vides que ça affiche un message a côte.

      Encore une question... (j'abuse? :$)

      Sheets(i).Name = "Lot n° " & Sheets(i).Range("C3").Value & Sheets(i).Range("D3").Value

      je peux utiliser & ""& pour mettre un esapce entre Sheets(i).Range("C3").Value et Sheets(i).Range("D3").Value ?
      0
    3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      oui, à condition de mettre un espace entre tes deux guillemets... 

      Sheets(i).Name = "Lot n° " & Sheets(i).Range("C3").Value & " " & Sheets(i).Range("D3").Value
      0
    4. Rayy87 Messages postés 32 Statut Membre
       
      :D
      J'ai commencé cette procédure pour dupliquer une feuille et la renommer.
      Ca bloque je pense sur une questoin de nom incorrect.










      Sub dupliquer_feuilles()

      Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
      With fDialog
      'Allow user to make multiple selections in dialog box.
      .AllowMultiSelect = True
      .ButtonName = "Valider"
      'Set the title of the dialog box.
      .Title = "Veuillez selectionner les fichiers à traiter"

      'Clear out the current filters, and add our own.
      .Filters.Clear

      .Filters.Add "Excel Files", "*.xls;*.xlw, 1"
      .Filters.Add "Excel Files", "*.xlsx, 1"
      .Filters.Add "Excel Files", "*.xlsm, 1"
      .Filters.Add "All Files", "*.*"
      .InitialFileName = "C:\InitialPath\"
      .InitialView = msoFileDialogViewList


      'Show the dialog box. If the .Show method returns True, the
      'user picked at least one file. If the .Show method returns
      'False, the user clicked Cancel.
      If .Show = True Then
      If .SelectedItems.Count > 0 Then
      fPath = .SelectedItems(1) & "\"
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      Application.EnableEvents = False
      'Loop through each file selected and add it to the list box.

      For Each varFile In .SelectedItems


      Workbooks.Open varFile





      'Procédure duplication de la feuille Lot n° x
      nomb = InputBox("Nombre de fois que vous souhaitez dupliquer la feuille", "Nombre")
      nomb = nomb - 1
      With varFile
      For i = 1 To Sheets.Count

      If Sheets(i).Name <> ("Lisez moi") Then
      If Sheets(i).Name <> ("Paramètres") Then

      For j = 1 To nomb
      Sheets(ongl & " " & i).Select
      Sheets(ongl & " " & i).Copy After:=Sheets(i + 2)
      ActiveSheet.Name = ongl & " " & i + 1

      Next j
      End If
      End If

      Next


      End With

      Next
      End If
      End If
      End With



      End Sub
      0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses