Code VBA pour recherchev sur des gros fichiers

et mince je n'arrive pas à activer les macros...

est ce qu'il serait possible de m'envoyer la macro par texte svp? car je ne peux activer aucune macro qui vient de l'exterieur (internet)

RE

Sub Moulinette2()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dossier = Range("Dossier")

Debut = Timer

Fichier = Dir(Dossier)
Do While Fichier <> ""
    Set WK = Workbooks.Open(Dossier & Fichier)
    For Each WS In WK.Worksheets
        If WS.Name <> "BASE" Then
            Dim TPlage() As Variant
            TPlage = WS.Range("B1").CurrentRegion.Value
            For i = 1 To UBound(TPlage, 1)
                For J = 1 To UBound(TPlage, 2)
                    TPlage(i, J) = Application.VLookup(TPlage(i, J), WK.Worksheets("Base").Range("A:B"), 2, 0)
                Next J
            Next i
            WS.Range(WS.Cells(i + 3, 2), WS.Cells(i * 2 + 1, J)) = TPlage
        End If
    Next WS
    WK.Close SaveChanges:=True
    Fichier = Dir()
Loop
MsgBox "Temps d'exécution : " & Timer - Debut & " secondes."
Application.Calculation = xlCalculationAutomatic

End Sub

La cellule où est notée le nom du dossier est nommée et utilisée dans ce code

Bonsoir 78chris,

Pourrais-tu tester mon classeur et me dire ce qu'il en est ? (cliquez sur Init puis sur Hop!)

D'avance, merci.

Re Lilie3887 ,

Voici en animation comment débloquer les macros d'un fichier (une des méthodes).

Le fichier a été téléchargé depuis le site XLP dans le dossier C:\toto\tata.

1. Ouvrir le classeur téléchargé : les macros sont bloquées -> refermer le classeur
2. Dans l'explorateur de fichiers, cliquer-droit sur le fichier
3. Choisir le sous-menu Propriétés
4. Cliquer sur la case d'option "Débloquer"
5. Ré-ouvrir le classeur : les macros sont débloquées

RE

mafraise a écrit :

Pourrais-tu tester mon classeur et me dire ce qu'il en est ? (cliquez sur Init puis sur Hop!)

Tu travailles sur le classeur en cours, pas sur tous les classeurs

Je l'ai modifié pour ce faire et il est plus rapide que mon code : il traite 3 fichiers, dont le tien avec plein d'onglets, en 50 secondes

Merci mafraise

et merci 78 chris car ça à fonctionné:

merci beaucoup à vous, vous m'avez fait gagner un temps précieux.

Par contre j'aurais aimé savoir comment vous faîtes pour mettre des macros sous un bouton. (vous m'avez fait connaître un autre aspect d'Excel et je suis curieuse)

:-)

RE

Teste le code de mafraise (un peu amendé par moi) : il est plus rapide

Sub Moulinette3()
Dim tref, k&, i&, j&, t, dico As New dictionary, nf&, nc@, deb, Dossier As String

deb = Timer: Application.ScreenUpdating = False
Dossier = Range("Dossier")

Fichier = Dir(Dossier)
Do While Fichier <> ""
    Set WK = Workbooks.Open(Dossier & Fichier)
    With WK.Sheets("base")
      .Move Before:=Sheets(1)
      If .FilterMode Then .ShowAllData
      tref = .Range("a3:b" & .Cells(Rows.Count, "a").End(xlUp).Row)
      Set dico = CreateObject("scripting.dictionary")
      dico.CompareMode = TextCompare
      tref = Intersect(Rows("3:" & Rows.Count), .Range("a3").CurrentRegion)
      For i = 1 To UBound(tref)
         If Trim(tref(i, 1)) <> "" Then dico(tref(i, 1)) = tref(i, 2)
      Next i
   End With

   For k = 2 To WK.Worksheets.Count
      With WK.Worksheets(k)
         nf = nf + 1
         If .FilterMode Then .ShowAllData
         t = Intersect(.Columns("b").Resize(, Columns.Count - 1), .Range("b2").CurrentRegion)
         ReDim res(1 To UBound(t), 1 To UBound(t, 2))
         For i = 1 To UBound(t)
            For j = 1 To UBound(t, 2)
               nc = nc + 1
               If dico.Exists(t(i, j)) Then res(i, j) = dico(t(i, j))
            Next j
         Next i
         .Range("b11").Resize(Rows.Count - 11, Columns.Count - 1).Clear
         With .Range("b11").Resize(UBound(res), UBound(res, 2))
            .Value = res
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
         End With
      End With
    Next k
    WK.Close SaveChanges:=True
    Fichier = Dir()

 Loop

   MsgBox Format(nf, "#,##0\ feuilles examinées.") & vbLf & _
      Format(nc, "#,##0\ cellules traitées.") & vbLf & _
      "en " & Format(Timer - deb, "#,##0.0\ s.")
End Sub

Pour lier le bouton à une macro : clic droit sur le bouton, Affecter une macro et la sélectionner

D'accord, mais le chemin du dossier je dois le mettre ou?

Je ne sais pas comment faire pour essayer la macro de mafraise.

Pouvez vous m'envoyer en fichier excel svp avec le bouton?

Merci d'avance :-)

RE

Bonsoir à tous,

Arrrrgh ! 78chris m'a devancé.

Ma version avec un affichage de l'avancement via un userform...

Version 3a avec affichage avancé peaufiné.

Super merci à vous 2

Re Lilie3887,

Ca fait toujours plaisir d'arriver à trouver une solution à une question et surtout d'avoir un retour. J'ai apprécié la collaboration avec 78chris .

Bonne continuation à tous les deux...

imaginons que je mette le tableau de BASE dans la colonne E et F comme ceci:

et que dans les autres feuilles au lieu de commencer à copier dans la cellule B11, je veux que les valeurs soient dans la cellule B21?

pouvez vous me donner exactement la même chose mais avec ses modifications s'il vous plaît?

j'ai essayé de le faire mais je me suis emmêler les pinceaux

Re ,

imaginons que je mette le tableau de BASE dans la colonne E et F

Pour votre dernière demande, voyez le fichier joint.

Merci beaucoup ma fraise

Re tous le monde,

J'aurais une autre demande s'il vous plaît à la suite de ma première demande?

Une fois la macro effectué j'obtiens ceci :

J'aimerais faire la somme pour chaque colonne de la ligne 11 la ligne 19 et j'aimerais que cette somme soit mise sur la ligne 21, de tous les fichiers qui se trouve dans mon dossier.

Avez vous une macro qui serait rapide s'il vous plaît?

Bonjour Lilie3887 ,

Je ne comprends plus rien à ce que vous voulez et à ce que vous ne voulez pas !

Vous avez écrit dans le message de 0:49 ceci :

et que dans les autres feuilles au lieu de commencer à copier dans la cellule B11, je veux que les valeurs soient dans la cellule B21?

Et maintenant vous demandez ceci :

J'aimerais faire la somme pour chaque colonne de la ligne 11 la ligne 19 et j'aimerais que cette somme soit mise sur la ligne 21, de tous les fichiers qui se trouve dans mon dossier.

Je ne comprends pas la cohérence de votre demande. On a d'abord placé les résultats en B11, puis déplacé les résultats en B21 et maintenant on nous reparle de B11 !

Bonjour

Lilie3887 a écrit :

imaginons que je mette le tableau de BASE dans la colonne E et F comme ceci:

et que dans les autres feuilles au lieu de commencer à copier dans la cellule B11, je veux que les valeurs soient dans la cellule B21?

pouvez vous me donner exactement la même chose mais avec ses modifications s'il vous plaît?

j'ai essayé de le faire mais je me suis emmêler les pinceaux

On peut aussi trouver la position des données de Base où qu'elles soient : il faut cependant que la structure soit inchangée

Sub Moulinette3()
Dim tref, k&, i&, j&, t, dico As New dictionary, nf&, nc@, deb, Dossier As String, Col As Integer, Lig As Long, Coin As Range

deb = Timer: Application.ScreenUpdating = False
Dossier = Range("Dossier")

Fichier = Dir(Dossier)
Do While Fichier <> ""
    Set WK = Workbooks.Open(Dossier & Fichier)
    With WK.Sheets("Base")
      .Move Before:=Sheets(1)
    Set Coin = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
     Col = Coin.Column
     Lig = Coin.Row + 1
     Lig2 = Coin.End(xlDown).Row
      If .FilterMode Then .ShowAllData
      tref = .Range(.Cells(Lig, Col), .Cells(Lig2, Col + 1))
      Set dico = CreateObject("scripting.dictionary")
      dico.CompareMode = TextCompare
      tref = Intersect(Rows("3:" & Rows.Count), .Range("a3").CurrentRegion)
      For i = 1 To UBound(tref)
         If Trim(tref(i, 1)) <> "" Then dico(tref(i, 1)) = tref(i, 2)
      Next i
   End With

   For k = 2 To WK.Worksheets.Count
      With WK.Worksheets(k)
         nf = nf + 1
         If .FilterMode Then .ShowAllData
         t = Intersect(.Columns("b").Resize(, Columns.Count - 1), .Range("b2").CurrentRegion)
         ReDim res(1 To UBound(t), 1 To UBound(t, 2))
         For i = 1 To UBound(t)
            For j = 1 To UBound(t, 2)
               nc = nc + 1
               If dico.Exists(t(i, j)) Then res(i, j) = dico(t(i, j))
            Next j
         Next i
         .Range("b11").Resize(Rows.Count - 11, Columns.Count - 1).Clear
         With .Range("b11").Resize(UBound(res), UBound(res, 2))
            .Value = res
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
         End With
      End With
    Next k
    WK.Close SaveChanges:=True
    Fichier = Dir()

 Loop

   MsgBox Format(nf, "#,##0\ feuilles examinées.") & vbLf & _
      Format(nc, "#,##0\ cellules traitées.") & vbLf & _
      "en " & Format(Timer - deb, "#,##0.0\ s.")
End Sub

Ce code je le remplace sur l'ancien code à la place de Sub moulinette3 ()mais le reste du code ne change pas c'est ça?