Microsoft 365 Lenteur Macro pour ajouter des éléments a une comboBox

[NecroXls]

Bonjour voici une procédure me permettant de remplir les éléments d'une comboBox
mais celle ci est très lente

y a t'il moyen de l'optimiser?

Private Sub InitArmes()
j = Combattant.Value
EquipementAdd.Clear


        For Each Row2 In Range("Armes").ListObject.ListRows
            TypeEnCours = Row2.Range(1, Range("Armes").ListObject.ListColumns("Type").Index)
                ArmeEnCours = Row2.Range(1, Range("Armes").ListObject.ListColumns("English").Index)
                insertion = False
                If Statut.Value = "Modification" Then
                    For Each Row3 In Range("CombattantsTemplateTypesArmes").ListObject.ListRows
                        If Row3.Range(1, Range("CombattantsTemplateTypesArmes").ListObject.ListColumns("Combattant").Index) = RangValue(j, 0) _
                        And Row3.Range(1, Range("CombattantsTemplateTypesArmes").ListObject.ListColumns("TypeArme").Index) = TypeEnCours Then
                            insertion = True
                            Exit For
                        End If
                    Next
                    For Each Row3 In Range("CombattantsTemplateArmes").ListObject.ListRows
                        If Row3.Range(1, Range("CombattantsTemplateArmes").ListObject.ListColumns("Combattant").Index) = RangValue(j, 0) _
                        And Row3.Range(1, Range("CombattantsTemplateArmes").ListObject.ListColumns("Arme").Index) = ArmeEnCours Then
                            insertion = True
                            Exit For
                        End If
                    Next
                Else
                    For Each Row3 In Range("CombattantsTemplateArmes").ListObject.ListRows
                        If Row3.Range(1, Range("CombattantsTemplateArmes").ListObject.ListColumns("Combattant").Index) = RangValue(j, 0) _
                        And Row3.Range(1, Range("CombattantsTemplateArmes").ListObject.ListColumns("Arme").Index) = ArmeEnCours Then
                            insertion = True
                            Exit For
                        End If
                    Next
                End If
                If insertion = True Then
                    If Langue.Value = "English" Or Row2.Range(1, Range("Armes").ListObject.ListColumns("Français").Index) = Empty Then
                        EquipementAdd.AddItem Row2.Range(1, Range("Armes").ListObject.ListColumns("English").Index)
                    Else
                        EquipementAdd.AddItem Row2.Range(1, Range("Armes").ListObject.ListColumns("Français").Index)
                    End If
                End If
        Next
End Sub

note Statut.Value est <> de "Modification" dans mon cas de test (mais ca ne change rien sur les perf car c'est tout aussi long en "Modification")
Armes contient 300 lignes
CombattantsTemplateArmes contient 1000 lignes environ
CombattantsTemplateTypeArmes contient 90lignes environ
merci d'avance

 

[Dudu2]

Bonjour,

Je ne suis pas familier avec ta façon d'utiliser les tableaux structurés en VBA.
Et le fait de ne pas déclarer les vairables (perso ça me gène mais ce n'est que moi).

Ce qui est sûr c'est que ça va toujours 8 fois plus vite lorsqu'on charge les cellules des Ranges en mémoire dans des tableaux.

    Dim TabArmes() As Variant
    Dim TabCombattantsTemplateTypesArmes() As Variant
    Dim TabCombattantsTemplateArmes() As Variant
 
    TabArmes = Range("Armes").Parent.ListObjects("Armes").DataBodyRange.Value
    TabTabCombattantsTemplateTypesArmes = Range("TabCombattantsTemplateTypesArmes").Parent.ListObjects("TabCombattantsTemplateTypesArmes").DataBodyRange.Value
    TabCombattantsTemplateArmes = Range("TabCombattantsTemplateArmes").Parent.ListObjects("TabCombattantsTemplateArmes").DataBodyRange.Value

Ou encore

    TabArmes = [Armes].Value
    TabTabCombattantsTemplateTypesArmes = [CombattantsTemplateTypesArmes].Value
    TabCombattantsTemplateArmes = [CombattantsTemplateArmes].Value

Tu peux aussi ne charger que des colonnes dans un table:

    TabArmesEnglish = [Armes[English]].Value

Les Tabxxx() sont des tableaux à 2 dimensions (de LBound = 1 dans les 2 dimensions) qui représentent en lignes et en colonnes exactement les valeurs du DataBodyRange des tableaux structurés.

On peut donc travailler dessus aisément, en utilisant:
- Ubound(Tabxxx, 1) pour le nombre de lignes
- Ubound(Tabxxx, 2) pour le nombre de colonnes
- et même le ListColumns(<nom colonne>).Index pour indexer une colonne particulières.

 

[NecroXls]

j'ai remplacer par ceci et ca marche super bien
un grand merci

Private Sub InitArmes()
Dim L As Integer
Dim J As Integer
Dim Insertion As Boolean

Dim TabArmesEnglish() As Variant
Dim TabArmesFrancais() As Variant
Dim TabArmesType() As Variant

Dim TabCombattantsTemplateTypesArmes() As Variant
Dim TabCombattantsTemplateArmes() As Variant

J = Combattant.Value
EquipementAdd.Clear


'TabArmesEnglish = Range("Armes").ListObject.ListColumns("English")
TabArmesEnglish = [Armes[English]].Value
TabArmesFrancais = [Armes[Français]].Value
TabArmesType = [Armes[Type]].Value

TabCombattantsTemplateTypesArmesCombattant = [CombattantsTemplateTypesArmes[Combattant]].Value
TabCombattantsTemplateTypesArmesType = [CombattantsTemplateTypesArmes[TypeArme]].Value

TabCombattantsTemplateArmesCombattant = [CombattantsTemplateArmes[Combattant]].Value
TabCombattantsTemplateArmesArme = [CombattantsTemplateArmes[Arme]].Value

For k = LBound(TabArmesEnglish) To UBound(TabArmesEnglish)
    TypeEnCours = TabArmesType(k, 1)
    ArmeEnCours = TabArmesEnglish(k, 1)
    Insertion = False
    If Statut.Value = "Modification" Then
        For L = LBound(TabCombattantsTemplateTypesArmesType) To UBound(TabCombattantsTemplateTypesArmesType)
            If TabCombattantsTemplateTypesArmesType(L, 1) = TabArmesType(k, 1) And TabCombattantsTemplateTypesArmesCombattant(L, 1) = RangValue(J, 0) Then
                Insertion = True
                Exit For
            End If
        Next
        For L = LBound(TabCombattantsTemplateArmesCombattant) To UBound(TabCombattantsTemplateArmesCombattant)
            If TabCombattantsTemplateArmesCombattant(L, 1) = RangValue(J, 0) And TabCombattantsTemplateArmesArme(L, 1) = TabArmesEnglish(k, 1) Then
                Insertion = True
                Exit For
            End If
        Next
    Else
        For L = LBound(TabCombattantsTemplateArmesCombattant) To UBound(TabCombattantsTemplateArmesCombattant)
            If TabCombattantsTemplateArmesCombattant(L, 1) = RangValue(J, 0) And TabCombattantsTemplateArmesArme(L, 1) = TabArmesEnglish(k, 1) Then
                Insertion = True
                Exit For
            End If
        Next
    End If
    
    If Insertion = True Then
        If Langue.Value = "English" Or TabArmesFrancais(k, 1) = Empty Then
            EquipementAdd.AddItem TabArmesEnglish(k, 1)
        Else
            EquipementAdd.AddItem TabArmesFrancais(k, 1)
        End If
    End If
Next


End Sub

 

[Dudu2]

Bonjour,

Bien joué pour l'intégration rapide !

Voici quelques notations pouvant s'avérer utiles pour les tableaux structurés en VBA.
Il peut être intéressant de passer par une variable ListObject représentant le tableau souvent notée "Tbl" (ou "Tblxxx" si plusieurs tableaux).
Cela permet d'une part de "variabiliser" (dans des variables String) le nom des tableaux structurés manipulés et d'autre part d'adresser des sous-parties (Header et Total) des tableaux structurés, 2 choses que la notation directe [<nom tableau>[<nom colonne>]] ne permet pas de faire (sauf à jouer de l'Offset ce qui ne serait pas très élégant envers de si beaux ListObjects).

Sub a()
    Dim t() As Variant
    Dim h() As Variant
    Dim s() As Variant
    Dim Tbl As ListObject
    Dim v As Variant
 
    Set Tbl = [Tableau1].ListObject
    'Ou encore
    Set Tbl = Range("Tableau1").ListObject
    'Ou encore
    Set Tbl = Range("Tableau1").Parent.ListObjects("Tableau1")
 
    t = [Tableau1].Value            'Rend le DataBodyRange  (If Not [Tableau1] Is Nothing)
    t = Range("Tableau1").Value     'Rend le DataBodyRange  (If Not Range("Tableau1") Is Nothing)
    t = Tbl.DataBodyRange.Value     'Rend le DataBodyRange  (If Not Tbl.DataBodyRange Is Nothing)
    h = Tbl.HeaderRowRange.Value    'Rend le HeaderRowRange (If Not Tbl.HeaderRowRange Is Nothing)
    s = Tbl.TotalsRowRange.Value    'Rend le TotalsRowRange (If Not Tbl.TotalsRowRange Is Nothing)
 
    t = [Tableau1[T2]].Value                        'Rend le DataBodyRange de la colonne de nom "T2" (If Not [Tableau1] Is Nothing  et si colonne "T2" existe)
    'Ou encore
    t = Tbl.ListColumns("T2").DataBodyRange.Value   'Rend le DataBodyRange de la colonne de nom "T2" (If Not Tbl.DataBodyRange Is Nothing et si colonne "T2" existe)
 
    t = Tbl.ListColumns(2).DataBodyRange.Value      'Rend le DataBodyRange de la colonne 2 (If Not Tbl.DataBodyRange Is Nothing et si colonne 2 existe)
 
    'v = Tbl.ListColumns(2).HeaderRowRange.Value    'Instruction (anormalement de mon point de vue) invalide !
    'v = Tbl.ListColumns("T2").TotalsRowRange.Value 'Instruction (anormalement de mon point de vue) invalide !
 
    v = Tbl.HeaderRowRange(2).Value      'Rend le titre de la colonne 2 (If Not Tbl.HeaderRowRange Is Nothing et si colonne 2 existe)
    v = Tbl.TotalsRowRange(2).Value      'Rend le total de la colonne 2 (If Not Tbl.TotalsRowRange Is Nothing et si colonne 2 existe)
    v = Tbl.ListColumns("T2").Index      'Rend le numéro de la colonne "T2" (If Not Tbl.HeaderRowRange Is Nothing et si colonne "T2" existe)
    v = Tbl.TotalsRowRange(Tbl.ListColumns("T2").Index).Value   'Rend le total de la colonne "T2" (If Not Tbl.TotalsRowRange Is Nothing et If Not Tbl.HeaderRowRange Is Nothing et si colonne "T2" existe)
End Sub