Macro pour comparer des feuille excel identiques Fermé

Question

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

pijaku · Answer

Bonjour,

Regarde cette astuce : https://www.commentcamarche.net/faq/32961-vba-excel-lire-dans-un-classeur-ferme
et notamment l'exemple d'utilisation...

Rayy87 · Answer

Merci, c'est tout à fait ce qu'il me faut.
Je vais essayer d'adapter le code et je te dirais :)
Merci encore!

pijaku · Answer

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)

Rayy87 · Answer

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

pijaku · Answer

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

Rayy87 · Answer

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?

Macro pour comparer des feuille excel identiques

6 réponses

Discussions similaires