remplissage optimisé d'un tabeau

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion knaekes
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
K

knaekes

XLDnaute Occasionnel
Bonjour,

je cherche à remplir un tableau de façon rapide.

mes données d'entrées sont fournies sous forme de liste. Je souhaite synthétiser ces données dans un tableau.

Une succession de boucle me permettrais bien entendu d'y parvenir. Mais étant donné la taille (réelle) de la liste et du tableau, je cherche à optimiser ce remplissage.

Existe t-il un moyen autre que une succession de boucle?

ci-joint le fichier exemple.

bonne journée
 

Pièces jointes

Trier par date Trier par votes
Re : remplissage optimisé d'un tabeau

Re
je t'avais demandé de me noter manuellement les résultats attendus pour que je puisse comprendre. Où les as-tu notés ?
A défaut de ces indications je me suis donc référé aux plages colorées en vert DONC J10:M13 et S10:S13.Comme les colonnes 12 à 16 sont vides dans ton exemple, je me suis servi de cet élément dans le code.
J'ai donc affecté à Plage l'ensemble des colonnes puis n'ai pris en compte que les colonnes non vides.
Place ce code entre DerLigne=b2 et application.screenUpdating=true (ce qui soit dit en passant doit être effacé car il apparaît en fin de code, là où il doit être) :
Code: 
Set Plage = Range(Cells(10, 10), Cells(DerLigne, 19))
Set Mondico = CreateObject("scripting.Dictionary")
ligne = 1
For i = 1 To Plage.Rows.Count
    temp = Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & Plage(i, 10)
    'MsgBox (temp)
        If Not Mondico.exists(temp) Then
            'MsgBox (temp)
            Mondico.Add temp, temp
            compt = compt + 1
            k = 1
            Dim Tablo()
            ReDim Preserve Tablo(1 To Plage.Rows.Count, 1 To Plage.Columns.Count)
                For j = 1 To Plage.Columns.Count
                If Plage(i, j) <> "" Then
                    Tablo(ligne, k) = Plage(i, j): k = k + 1
                    End If
                Next j
            ligne = ligne + 1
        End If
Next i
f2.Select
[E5].Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
'[E5].Resize(Plage.Columns.Count, Mondico.Count).Replace What:="", Replacement:="-", SearchOrder:=xlByColumns
Je n'ai pas testé la suite de la macro mais cela fonctionne jusque-là.
A toi maintenant de finir le travail.
A+
 
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Merci pour ton travail, mais ... (desolé)

1. le résultat que je souhaite obtenir est effectivement celui encadré en vert dans l'onglet "rouge"

2. Certaines colonnes sont effectivement vides, mais si elles existent c'est bien que je les remplirai de données variés et non utilisable dans la procédure. Pour materialisé ces données (texte varié) j'avais dans un précédent exemple rempli ces cellules de texte. Pour un souci de lisibilité je les a nouveau effacé.

Toutefois au lieu cibler ces colonnes par la propriété "cellules vide" je pourai les cibles selon leur numero de colonne

3. Par contre ce que je ne comprends pas c'est que tu me propose de modifier la macro intitulée "Sub liste_horizontale" alors que l'erreur apparait dans la macro "remplir_tableau_rouge".
Lorsque tu executes la macro en cliquant sur le bouton bleu tu repères de suite où se trouve l'erreur qui me pose probleme.
Lorsque tu executes la macro en cliquant sur le bouton jaune tu constates que ça fonctionne correctement (mais les données de départs sont toutes adjacentes).

Mon but est d'afficher le tableau vert (onglet rouge), mais en ne se servant uniquement des donnes d'entrées surlignées en vert dans l'onglet bleu

ci-joint le fichier
 

Pièces jointes

Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re
désolé mais j'ai revu ta macro pas à pas et je ne comprends rien à ton code. J'ai l'impression que tu as fais une usine à gaz avec des parties de codes redondants et d'autres (les tri notamment) dont je ne vois pas à quoi ils servent.
Si cela se trouve la solution à ton plantage est peut-être simple mais là je ne vois pas.
Je suis vraiment désolé mais dans ces conditions je ne vois pas comment je peux te dépanner.
Si j'ai bien suivi le déroulement de ton code en comparant l'affichage des résultats avec l'exemple encadré en vert,
Colonne8 A B C
Colonne9 CC CC AA
Colonne10 CCC CCC AAA
Colonne11 BBBB BBBB BBBB


F1
F2
s'affichent mais les nombres ne s'affichent pas.
Je ne comprends même pas d'ailleurs l'intérêt de ta macro remplir_tableau_rouge1 pour obtenir les données que tu veux afficher (mais bon, l'important c'est que toi tu le comprennes).
J'espère que quelqu'un pourra te solutionner ton plantage.
A+
 
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

En fait le remplissage des entêtes verticales et horizontales ne me posent ps de problème.

C'est bien la procédure "remplir_tableau" (que tu m'as proposée et qui fait l'objet de ce post) qui me pose souci.

Mon problème est bien que les nombres ne saffichent pas

ci-joint le fichier sans les macro "inutiles"
 

Pièces jointes

Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re
chez moi, tes 2 macros ne fonctionnent pas.
Le problème, c'est qu'en modifiant ta demande, cela a des répercussions sur l'ensemble du code.
J'ai refait un code que l'on doit pouvoir simplifier mais qui fonctionne sur ton fichier exemple :
Code: 
Sub remplir_tableau_rouge1()
Dim f1 As Worksheet, f2 As Worksheet, Mondico As Object, Mondico2 As Object, Mondico3 As Object, Mondico4 As Object, _
Plage As Range, Plage2 As Range, i&, j&, k&, c As Range, compteur&, Col, Tabl2, Tabl3, Tabl4, Tabl5
Set Mondico = CreateObject("Scripting.Dictionary")
Set Mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set Mondico4 = CreateObject("Scripting.Dictionary")
Set f1 = Sheets("bleue")
Set f2 = Sheets("rouge")

'-----------bornes
'------------procedure

With f1
    Col = .Range(.Cells(9, 10), .Cells(9, 13)).Value
    Set Plage = .Range(.Cells(10, 10), .Cells(13, 13))
        For i = 1 To Plage.Rows.Count
            If Not Mondico.exists(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) Then
                Mondico.Add Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4), 1
                compteur = compteur + 1
                Dim tabl()
                ReDim Preserve tabl(1 To Plage.Rows.Count, Plage.Columns.Count)
                    For j = 1 To Plage.Rows.Count: tabl(j, compteur - 1) = Plage(i, j): Next j
            End If
        Next i
        
        For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) + 1
        Next i
        
    Tabl2 = Mondico2.items
    
    Set Plage2 = .Range(.Cells(10, 10), .Cells(13, 19))
        For i = 1 To Plage2.Rows.Count
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) = _
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) + 1
        Next i
    Tabl3 = Mondico3.keys
    Tabl4 = Mondico3.items
            
        For Each c In .Range("S10", .Range("S" & Rows.Count).End(xlUp))
           Mondico4(c.Value) = c.Value
        Next c
    Tabl5 = Mondico4.keys
End With

With f2
    .Range("F24").Resize(Plage.Rows.Count, Plage.Columns.Count) = tabl
    .Range("E30").Resize(Mondico4.Count) = Application.Transpose(Tabl5)
    .Range("E24").Resize(Plage.Columns.Count) = Application.Transpose(Col)
    
    For i = 1 To Mondico4.Count
        For k = LBound(Tabl4) To UBound(Tabl4)
            If Right(Tabl3(k), 2) = .Cells(i + 29, 5).Value Then Cells(i + 29, k + 6) = Tabl4(k)
         Next k
    Next i
End With
End Sub
A toi maintenant de l'adapter à ton fichier original et de le modifier si tu venais à modifier de nouveau ta demande.
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

salut david84

merci pour ta réponse. Cette fois-ci ça correspond à ce que je cherchais. D'ailleurs j'ai trouvé mon erreur ds mon exemple précédent.

Par contre, je reste bloqué sur un point (décidemment). Je ne trouve pas comment adapter la macro si je rajoute une 5 ieme ligne de donnée (pourtant cela ne devrais pas être compliqué ?).

voici comment je pensais l'adapter:

Code: 
Sub remplir_tableau_rouge1()
Dim f1 As Worksheet, f2 As Worksheet, Mondico As Object, Mondico2 As Object, Mondico3 As Object, Mondico4 As Object, _
Plage As Range, Plage2 As Range, i&, j&, k&, c As Range, compteur&, Col, Tabl2, Tabl3, Tabl4, Tabl5
Set Mondico = CreateObject("Scripting.Dictionary")
Set Mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set Mondico4 = CreateObject("Scripting.Dictionary")
Set f1 = Sheets("bleue")
Set f2 = Sheets("rouge")

'-----------bornes
'------------procedure

With f1
    Col = .Range(.Cells(9, 10), .Cells(9, 13)).Value
' plage de la ligne 10 à la ligne 14 !
    Set Plage = .Range(.Cells(10, 10), .Cells(14, 13))
        'Plage.Select
        For i = 1 To Plage.Rows.Count
            If Not Mondico.exists(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) Then
                Mondico.Add Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4), 1
                compteur = compteur + 1
                Dim tabl()
                ReDim Preserve tabl(1 To Plage.Rows.Count, Plage.Columns.Count)
                    For j = 1 To Plage.Rows.Count: tabl(j, compteur - 1) = Plage(i, j): Next j
            End If
        Next i
        
        For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) + 1
        Next i
        
    Tabl2 = Mondico2.items
    
    Set Plage2 = .Range(.Cells(10, 10), .Cells(14, 19))
        For i = 1 To Plage2.Rows.Count
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) = _
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) + 1
        Next i
    Tabl3 = Mondico3.keys
    Tabl4 = Mondico3.items
            
        For Each c In .Range("S10", .Range("S" & Rows.Count).End(xlUp))
           Mondico4(c.Value) = c.Value
        Next c
    Tabl5 = Mondico4.keys
End With

With f2
    .Range("F24").Resize(Plage.Rows.Count, Plage.Columns.Count) = tabl
    .Range("E30").Resize(Mondico4.Count) = Application.Transpose(Tabl5)
    .Range("E24").Resize(Plage.Columns.Count) = Application.Transpose(Col)
    
    For i = 1 To Mondico4.Count
        For k = LBound(Tabl4) To UBound(Tabl4)
            If Right(Tabl3(k), 2) = .Cells(i + 29, 5).Value Then Cells(i + 29, k + 6) = Tabl4(k)
         Next k
    Next i
End With
End Sub

saurais-tu m'indiquer mon erreur. Je te remercie pour ton aide
 
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re
ci-joint code modifié :
Code: 
Sub remplir_tableau_rouge1()
Dim f1 As Worksheet, f2 As Worksheet, Mondico As Object, Mondico2 As Object, Mondico3 As Object, Mondico4 As Object, _
Plage As Range, Plage2 As Range, DerLigne&, i&, j&, k&, c As Range, compteur&, Col, Tabl2, Tabl3, Tabl4, Tabl5
Set Mondico = CreateObject("Scripting.Dictionary")
Set Mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set Mondico4 = CreateObject("Scripting.Dictionary")
Set f1 = Sheets("bleue")
Set f2 = Sheets("rouge")

'-----------bornes
'------------procedure

With f1
    DerLigne = .Range("C" & Rows.Count).End(xlUp).Row
    Col = .Range(.Cells(9, 10), .Cells(9, 13)).Value
    Set Plage = .Range(.Cells(10, 10), .Cells(DerLigne, 13))
        For i = 1 To Plage.Rows.Count
            If Not Mondico.exists(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) Then
                Mondico.Add Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4), 1
                compteur = compteur + 1
                Dim tabl()
                ReDim Preserve tabl(1 To Plage.Columns.Count, Plage.Rows.Count)
                    For j = 1 To Plage.Columns.Count: tabl(j, compteur - 1) = Plage(i, j): Next j
            End If
        Next i
        
        For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) + 1
        Next i
        
    Tabl2 = Mondico2.items
    
    Set Plage2 = .Range(.Cells(10, 10), .Cells(DerLigne, 19))
        For i = 1 To Plage2.Rows.Count
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) = _
                Mondico3.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & "#" & Plage(i, 10)) + 1
        Next i
    Tabl3 = Mondico3.keys
    Tabl4 = Mondico3.items
            
        For Each c In .Range("S10", .Range("S" & Rows.Count).End(xlUp))
           Mondico4(c.Value) = c.Value
        Next c
    Tabl5 = Mondico4.keys
End With

With f2
    .Range("F24").Resize(Plage.Columns.Count, Plage.Rows.Count) = tabl
    .Range("E30").Resize(Mondico4.Count) = Application.Transpose(Tabl5)
    .Range("E24").Resize(Plage.Columns.Count) = Application.Transpose(Col)
    
    For i = 1 To Mondico4.Count
        For k = LBound(tabl) To UBound(Tabl2) + 1
            If Right(Tabl3(k - 1), 2) = .Cells(i + 29, 5).Value Then Cells(i + 29, k + 5) = Tabl4(k - 1)
         Next k
    Next i
End With
End Sub
J'ai rajouté plusieurs lignes et cela fonctionner (cf.fichier). Maintenant, si tu rajoutes d'autres contraintes, à toi de jouer et de modifier en conséquence.
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re re
Ci-joint nouveau code modifié (légèrement simplifié et optimisé) à tester :
Code: 
Sub remplir_tableau_rouge3()
Dim f1 As Worksheet, f2 As Worksheet, Mondico As Object, Mondico2 As Object, Mondico3 As Object, _
Plage As Range, DerLigne&, i&, j&, k&, c As Range, compteur&, Col, Tabl3, Tabl4, _
Nb&, Colonne%, Lig&
Set Mondico = CreateObject("Scripting.Dictionary")
Set Mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set f1 = Sheets("bleue")
Set f2 = Sheets("rouge")

'-----------bornes
'------------procedure

With f1

    DerLigne = .Range("C" & Rows.Count).End(xlUp).Row
    Set Plage = .Range(.Cells(10, 10), .Cells(DerLigne, 13))
    Col = .Range(.Cells(9, 10), .Cells(9, 13)).Value
    For i = 1 To Plage.Rows.Count
    Dim Tabl1()
    ReDim Preserve Tabl1(1 To Plage.Rows.Count, 1)
    Tabl1(i, 0) = Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)
    Tabl1(i, 1) = Plage(i, 10)
    Next i
    
        For i = 1 To Plage.Rows.Count
            If Not Mondico.exists(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) Then
                Mondico.Add Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4), 1
                compteur = compteur + 1
                Dim tabl2()
                ReDim Preserve tabl2(1 To Plage.Columns.Count, Plage.Rows.Count)
                    For j = 1 To Plage.Columns.Count: tabl2(j, compteur - 1) = Plage(i, j): Next j
            End If
        Next i
        
        For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) + 1
        Next i
    Tabl3 = Mondico2.keys
    
        For Each c In .Range("S10", .Range("S" & Rows.Count).End(xlUp))
           Mondico3(c.Value) = c.Value
        Next c
    Tabl4 = Mondico3.keys
End With

With f2
Colonne = 6
Lig = 30
    .Range("F24").Resize(Plage.Columns.Count, Plage.Rows.Count) = tabl2
    .Range("E30").Resize(Mondico3.Count) = Application.Transpose(Tabl4)
    .Range("E24").Resize(Plage.Columns.Count) = Application.Transpose(Col)
    For k = LBound(Tabl3) To UBound(Tabl3)
    For i = LBound(Tabl3) To UBound(Tabl3)
    If i > UBound(Tabl4) Then Exit For
        For j = LBound(Tabl1) To UBound(Tabl1)
            If Tabl1(j, 0) = Tabl3(k) And Tabl1(j, 1) = Tabl4(i) Then Nb = Nb + 1
        Next j
        j = 1
        Cells(Lig, Colonne) = Nb
        Lig = Lig + 1
        Nb = 0
    Next i
    Lig = 30
    Colonne = Colonne + 1
    Next k
        
End With
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Salut david84

Cette foi-ci je pense réussir à exploiter la macro dans le contexte de mon fichier (enfin j'espère).

En tout cas merci pour ta patience et ton aide
 
Dernière édition:
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re
Bon courage pour la suite.
A noter que tu peux effacer le +1 qui n'a plus d'utilité de :
Code: 
For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) + 1
        Next i
ce qui donne :
Code: 
For i = 1 To Plage.Rows.Count
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4))
        Next i
A+
 
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Bonjour,

je souhaite apporter une amélioration à la macro. En effet mon but est d'appliquer la macro uniquement aux cellules affichées dans l'onglet source. Certaines des lignes du tableau source peuvent êtres cachées (les données cachées ne sont pas à prendre en compte).

j'ai rajouté dans la macro la condition "si cellules affichées alors -> Ok / sinon on continu la boucle"

Le problème est qu'ainsi la macro, ne fonctionne que ds le cas où le nbr d'entêtes horizontales est supérieur au nbr d'éléments verticaux.

ci-joint, le fichier exemple

Comment faire?

merci d'avance
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Re
ci-joint ton code modifié. Il n'y avait pas grand chose à modifier (ligne signalée dans le code) et un simple déroulé pas à pas du code t'aurais sûrement permis de trouver toi-même ton erreur. Je ne sais pas si tu sais faire fonctionner ce mode pas à pas mais cela est simple et te permet au moins de trouver quelle est la partie de code qui fonctionne mal (si tu ne le sais pas, je t'encourage à étudier ce procédé).
Ce code fonctionne sur le fichier fourni en exemple.
Code: 
Sub remplir_tableau_rouge3()
Dim f1 As Worksheet, f2 As Worksheet, Mondico As Object, Mondico2 As Object, Mondico3 As Object, _
Plage As Range, DerLigne&, i&, j&, k&, c As Range, compteur&, Col, Tabl3, Tabl4, _
Nb&, Colonne%, Lig&
Set Mondico = CreateObject("Scripting.Dictionary")
Set Mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set f1 = Sheets("bleue")
Set f2 = Sheets("rouge")

'-----------bornes
'------------procedure

With f1

    DerLigne = .Range("C" & Rows.Count).End(xlUp).Row
    Set Plage = .Range(.Cells(10, 10), .Cells(DerLigne, 13))
    Col = .Range(.Cells(9, 10), .Cells(9, 13)).Value
    For i = 1 To Plage.Rows.Count
    If f1.Cells(i + 9, 10).EntireRow.Hidden = False Then
    Dim Tabl1()
    ReDim Preserve Tabl1(1 To Plage.Rows.Count, 1)
    Tabl1(i, 0) = Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)
    Tabl1(i, 1) = Plage(i, 10)
    End If
    Next i
    
        For i = 1 To Plage.Rows.Count
            If f1.Cells(i + 9, 10).EntireRow.Hidden = False Then
            If Not Mondico.exists(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) Then
                Mondico.Add Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4), 1
                compteur = compteur + 1
                Dim tabl2()
                ReDim Preserve tabl2(1 To Plage.Columns.Count, Plage.Rows.Count)
                    For j = 1 To Plage.Columns.Count: tabl2(j, compteur - 1) = Plage(i, j): Next j
            End If
            End If
        Next i
        
        For i = 1 To Plage.Rows.Count
            If f1.Cells(i + 9, 10).EntireRow.Hidden = False Then
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4)) = _
            Mondico2.Item(Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4))
            End If
        Next i
    Tabl3 = Mondico2.keys
    
        i = 9
        For Each c In .Range("S10", .Range("S" & Rows.Count).End(xlUp))
        i = i + 1
        If f1.Cells(i, 10).EntireRow.Hidden = False Then
           Mondico3(c.Value) = c.Value
        End If
        Next c
    Tabl4 = Mondico3.keys
End With

With f2
Colonne = 6
Lig = 30
    .Range("F24").Resize(Plage.Columns.Count, Plage.Rows.Count) = tabl2
    .Range("E30").Resize(Mondico3.Count) = Application.Transpose(Tabl4)
    .Range("E24").Resize(Plage.Columns.Count) = Application.Transpose(Col)
    For k = LBound(Tabl3) To UBound(Tabl3)
    For i = LBound(Tabl4) To UBound(Tabl4) 'ligne modifiée
    If i > UBound(Tabl4) Then Exit For
        For j = LBound(Tabl1) To UBound(Tabl1)
            If Tabl1(j, 0) = Tabl3(k) And Tabl1(j, 1) = Tabl4(i) Then Nb = Nb + 1
        Next j
        j = 1
        Cells(Lig, Colonne) = Nb
        Lig = Lig + 1
        Nb = 0
    Next i
    Lig = 30
    Colonne = Colonne + 1
    Next k
        
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Re : remplissage optimisé d'un tabeau

Bonjour à vous
Dicussion intéressante
petite suggestion si je puis me permettre pour optimiser la vitesse, le code suivant ne gâterait rien
Public Sub Mfast()
'Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Choix&
Choix = 1
If Choix = 0 Then
Call "le nom de ta macro
Else
'Call Importdatas
'Call Reportrange
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Bien cordialement
Flyonets
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

E
  • Question Question
Microsoft 365 Création d'un filtre sur une cellule avec recherche de mot indexé
Réponses
3
Affichages
350
elgringo123456
E
Lu76Fer
  • Résolu(e)
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
853
Lu76Fer
Lu76Fer
oguruma
EXCEL :: TRIER - TRIER.PAR - SOMMEPROD - CHOISIR - INDEX - SOMME.SI - NB.SI - DECALER - SEQUENCE : Tris dynamiques, regroupements et somme
Réponses
0
Affichages
554
oguruma
oguruma
E
  • Résolu(e)
Microsoft 365 Conception d'un outils alliant faciliter d'utilisation et optimisation de la RAM/Processeur/Espace Disque
Réponses
6
Affichages
940
elgringo123456
E
F
  • Résolu(e)
XL 2010 appartenance d'un code dans une liste - VBA
Réponses
6
Affichages
842
ChTi160
ChTi160
P
  • Résolu(e)
XL 2019 Tri et sélection de cellules à partir d'une base textuelle
Réponses
2
Affichages
861
pistachacha
P
C
  • Résolu(e)
Microsoft 365 Avoir l'adresse d'une cellule qui est pointée par une rechercheV
Réponses
13
Affichages
1 K
Casim
C
D
  • Question Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
1 K
Dudu2
Dudu2
P
  • Résolu(e)
Microsoft 365 Extraire le nombre d'occurence d'un texte dans un tableau
Réponses
13
Affichages
2 K
Staple1600
Staple1600
L
  • Résolu(e)
Microsoft 365 RECHERCHEV/INDEX - Optimiser le temps de traitement pour la recherche dans un tableau à liste ?
2
Réponses
16
Affichages
4 K
loic.zambon
L
H
  • Question Question
XL 2010 Remplissage d'un tableau sous 2 conditions dynamiquement
Réponses
3
Affichages
995
hsf
H
A
  • Question Question
XL 2010 dessiner avec VBA sous excel 2010
2
Réponses
24
Affichages
6 K
artlight
A
S
  • Résolu(e)
XL 2013 Méthode de sélection alternative
Réponses
4
Affichages
2 K
stage_ferrit
S
vgendron
  • Question Question
Extraction Une colonne d'un Array
2
Réponses
23
Affichages
7 K
eriiic
eriiic
Anne-Marie
  • Question Question
Remplissage automatique d'un tableau principal à partir d'autres tableaux
Réponses
5
Affichages
2 K
bbb38
bbb38
E
  • Question Question
Chargement rapide de dictionaire en mémoire sur la base de cellules Excel
Réponses
7
Affichages
2 K
elgringo123456
E
J
  • Question Question
Importer donné d'un classeur excel dans un tableau Word
Réponses
0
Affichages
1 K
jeanBaptiste
J
I
  • Question Question
Récupérer des données de plusieurs feuilles pour faire un planning général
Réponses
0
Affichages
2 K
idlily
I
P
  • Question Question
Combobox qui ne se remplit pas
Réponses
5
Affichages
2 K
PierreJeanPierre
P
T
  • Question Question
[RESOLU] Optimisation d'un code
Réponses
2
Affichages
1 K
TgR
T
Retour