Simplification VBA

Bonjour à tous,

Je dispose d'un code VBA qui fonctionne mais je pense qu'il peut être simplifier surtout au niveau des RAZ des som , j'ai essayé avec:

For i=1 to 18
som(i)=0
Next i

Mais ça ne fonctionne pas. Voici le code intégral:

Sub SommeReportingQE()
Dim Nlgn As Integer
Dim tabBDD()
Dim wsBDD As Object
Dim wsResult As Object

Dim som1, som2, som3, som4, som5, som6, som7, som8, som9, som10, som11, som12, som13, som14, som15, som16, som17, som18
Dim crit1, crit2, crit3, crit4
Dim cptBDD
Dim i As Integer

Nlgn = ActiveCell.Column

    Set wsBDD = Worksheets("BDD")
    Set wsResult = Worksheets("Feuil1")

    With wsBDD
        tabBDD = Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 23))
    End With

    With wsResult

    som1 = 0
    som2 = 0
    som3 = 0
    som4 = 0
    som5 = 0
    som6 = 0
    som7 = 0
    som8 = 0
    som9 = 0
    som10 = 0
    som11 = 0
    som12 = 0
    som13 = 0
    som14 = 0
    som15 = 0
    som16 = 0
    som17 = 0
    som18 = 0

        Application.ScreenUpdating = False

        crit1 = .Cells(2, 1)
        crit2 = .Cells(1, Nlgn)
        crit3 = .Cells(8, 1)
        crit4 = .Cells(14, 1)

        For cptBDD = 1 To UBound(tabBDD, 1)
            If (tabBDD(cptBDD, 23) = crit1) And (tabBDD(cptBDD, 1) = crit2) Then
                som1 = som1 + tabBDD(cptBDD, 11)
                som2 = som2 + tabBDD(cptBDD, 22)
                som3 = som3 + tabBDD(cptBDD, 12)
                som4 = som4 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som5 = som5 + tabBDD(cptBDD, 19)
                som6 = som6 + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit3) And (tabBDD(cptBDD, 1) = crit2) Then
                som7 = som7 + tabBDD(cptBDD, 11)
                som8 = som8 + tabBDD(cptBDD, 22)
                som9 = som9 + tabBDD(cptBDD, 12)
                som10 = som10 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som11 = som11 + tabBDD(cptBDD, 19)
                som12 = som12 + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit4) And (tabBDD(cptBDD, 1) = crit2) Then
                som13 = som13 + tabBDD(cptBDD, 11)
                som14 = som14 + tabBDD(cptBDD, 22)
                som15 = som15 + tabBDD(cptBDD, 12)
                som16 = som16 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som17 = som17 + tabBDD(cptBDD, 19)
                som18 = som18 + tabBDD(cptBDD, 17)
            End If

        Next
        .Cells(2, Nlgn) = som1
        .Cells(3, Nlgn) = som2
        .Cells(4, Nlgn) = (.Cells(3, Nlgn) / som3)
        .Cells(5, Nlgn) = som4
        .Cells(6, Nlgn) = som5
        .Cells(7, Nlgn) = som6
        .Cells(8, Nlgn) = som7
        .Cells(9, Nlgn) = som8
        .Cells(10, Nlgn) = (.Cells(9, Nlgn) / som9)
        .Cells(11, Nlgn) = som10
        .Cells(12, Nlgn) = som11
        .Cells(13, Nlgn) = som12
        .Cells(14, Nlgn) = som13
        .Cells(15, Nlgn) = som14
        .Cells(16, Nlgn) = (.Cells(15, Nlgn) / som15)
        .Cells(17, Nlgn) = som16
        .Cells(18, Nlgn) = som17
        .Cells(19, Nlgn) = som18

    End With

    Set wsBDD = Nothing
    Set wsResult = Nothing

    Application.ScreenUpdating = True

End Sub

Merci

Bonjour,

en utilisant un tableau pour tes variables som on peut un peu simplifier le code (écriture) pas nécessairement son exécution.

Sub SommeReportingQE()
    Dim Nlgn As Integer
    Dim tabBDD()
    Dim wsBDD As Object
    Dim wsResult As Object

    Dim som(1 To 18)
    Dim crit1, crit2, crit3, crit4
    Dim cptBDD
    Dim i As Integer

    Nlgn = ActiveCell.Column

    Set wsBDD = Worksheets("BDD")
    Set wsResult = Worksheets("Feuil1")

    With wsBDD
        tabBDD = Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 23))
    End With

    With wsResult
        Erase som
        Application.ScreenUpdating = False

        crit1 = .Cells(2, 1)
        crit2 = .Cells(1, Nlgn)
        crit3 = .Cells(8, 1)
        crit4 = .Cells(14, 1)

        For cptBDD = 1 To UBound(tabBDD, 1)
            If (tabBDD(cptBDD, 23) = crit1) And (tabBDD(cptBDD, 1) = crit2) Then
                som(1) = som(1) + tabBDD(cptBDD, 11)
                som(2) = som(2) + tabBDD(cptBDD, 22)
                som(3) = som(3) + tabBDD(cptBDD, 12)
                som(4) = som(4) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som(5) = som(5) + tabBDD(cptBDD, 19)
                som(6) = som(6) + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit3) And (tabBDD(cptBDD, 1) = crit2) Then
                som(7) = som(7) + tabBDD(cptBDD, 11)
                som(8) = som(8) + tabBDD(cptBDD, 22)
                som(9) = som(9) + tabBDD(cptBDD, 12)
                som(10) = som(10) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som(11) = som(11) + tabBDD(cptBDD, 19)
                som(12) = som(12) + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit4) And (tabBDD(cptBDD, 1) = crit2) Then
                som(13) = som(13) + tabBDD(cptBDD, 11)
                som(14) = som(14) + tabBDD(cptBDD, 22)
                som(15) = som(15) + tabBDD(cptBDD, 12)
                som(16) = som(16) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som(17) = som(17) + tabBDD(cptBDD, 19)
                som(18) = som(18) + tabBDD(cptBDD, 17)
            End If
        Next

        For i = 1 To 18
            Select Case i
            Case 3, 9, 15
                .Cells(i + 1, Nlgn) = (.Cells(i, Nlgn) / som(i))
            Case Else
                .Cells(i + 1, Nlgn) = som(i)
            End Select
        Next i

    End With

    Set wsBDD = Nothing
    Set wsResult = Nothing

    Application.ScreenUpdating = True

End Sub

Salut Florian, H2SO4

Bonjour le forum,

A tester puisqu'on travaille un peu à l'aveugle, sans fichier !!

'
Dim wsBDD As Worksheet
Dim wsResult As Worksheet
Dim tabBDD()
Dim Som(19) As Integer, iCol As Integer
Dim crit1, crit2, crit3, crit4
'
Set wsBDD = Worksheets("BDD")
Set wsResult = Worksheets("Feuil1")
iCol = ActiveCell.Column
'
With wsBDD
    tabBDD = Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 23))
End With
'
Application.ScreenUpdating = False
'
With wsResult
    '
    crit1 = .Cells(2, 1)
    crit2 = .Cells(1, iCol)
    crit3 = .Cells(8, 1)
    crit4 = .Cells(14, 1)
    '
    For y = 1 To UBound(tabBDD, 1)
        Select Case tabBDD(y, 23) + tabBDD(y, 1)
            Case Is = (crit1 + crit2)
                x = 0
            Case Is = (crit3 + crit2)
                x = 1
            Case Is = (crit4 + crit2)
                x = 2
        End Select
        Som(1 + (x * 6)) = Som(1 + (x * 6)) + tabBDD(y, 11)
        Som(2 + (x * 6)) = Som(2 + (x * 6)) + tabBDD(y, 22)
        Som(3 + (x * 6)) = Som(3 + (x * 6)) + tabBDD(y, 12)
        Som(4 + (x * 6)) = Som(4 + (x * 6)) + tabBDD(y, 14) + tabBDD(y, 15) + tabBDD(y, 16) + tabBDD(y, 18) + tabBDD(y, 20)
        Som(5 + (x * 6)) = Som(5 + (x * 6)) + tabBDD(y, 19)
        Som(6 + (x * 6)) = Som(6 + (x * 6)) + tabBDD(y, 17)
    Next
    '
    For x = 1 To 18
        Select Case x
            Case 4, 10, 16
                .Cells(x + 1, iCol) = (.Cells(x, iCol) / Som(x))
            Case Else
                .Cells(x + 1, iCol) = Som(x)
        End Select
    Next
End With
'
Set wsBDD = Nothing
Set wsResult = Nothing
'
Application.ScreenUpdating = True
'

A+

Pas mal la simplification .

merci à vous, je n'en reviens pas de ta simplification curulis57 , elle est juste énorme. je vais la tester et je vous redis .

Florian,

ne te trompe pas de version : je l'ai changée deux fois en édition directe!

Quand c'est chaud, c'est chaud!

A+

J'ai essayé le code, j'ai une erreur "indice n'appartient pas à la selection " sur la ligne:

Select Case tabBDD(cptBDD, 23) + tabBDD(cptBDD, 1)

Je ne vois pas de déclaration pour "cptBDD" est ce pour ça que j'ai une erreur ?


Dsl je viens de voir ton message, du coup j'essaye la nouvelle version

Re,

Après essai, en fait ma première macro, insérer les formules de la colonne C à "dercol".

Quand j'ai utilisé ta macro, icol avait pour valeur "activecell.collumn".

J'ai fais une modif :

Sub SommeASS()

'
Dim wsBDD As Worksheet
Dim wsResult As Worksheet
Dim tabBDD()
Dim Som(19) As Long, iCol As Integer
Dim crit1, crit2, crit3, crit4
'
Set wsBDD = Worksheets("BDD")
Set wsResult = Worksheets("ASS Costs")

'
With wsBDD
    tabBDD = Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 23))
End With
'
Application.ScreenUpdating = False
'

With wsResult

dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For iCol = 3 To dercol
    '
   crit1 = .Cells(2, 1) 
    crit2 = .Cells(1, iCol) 
    crit3 = .Cells(9, 1) 
    crit4 = .Cells(15, 1) 
    '
   For y = 1 To UBound(tabBDD, 1)
        Select Case tabBDD(y, 23) + tabBDD(y, 1)
            Case Is = (crit1 + crit2)
                x = 0
            Case Is = (crit3 + crit2)
                x = 1
            Case Is = (crit4 + crit2)
                x = 2
        End Select
        Som(1 + (x * 6)) = Som(1 + (x * 6)) + tabBDD(y, 11)
        Som(2 + (x * 6)) = Som(2 + (x * 6)) + tabBDD(y, 22)
        Som(3 + (x * 6)) = Som(3 + (x * 6)) + tabBDD(y, 12)
        Som(4 + (x * 6)) = Som(4 + (x * 6)) + tabBDD(y, 14) + tabBDD(y, 15) + tabBDD(y, 16) + tabBDD(y, 18) + tabBDD(y, 20)
        Som(5 + (x * 6)) = Som(5 + (x * 6)) + tabBDD(y, 19)
        Som(6 + (x * 6)) = Som(6 + (x * 6)) + tabBDD(y, 17)
    Next
    '
   For x = 1 To 18
        Select Case x
            Case 4, 10, 16
                .Cells(x + 1, iCol) = (.Cells(x, iCol) / Som(x))
            Case Else
                .Cells(x + 1, iCol) = Som(x)
        End Select
    Next

    Next iCol
End With

'
Set wsBDD = Nothing
Set wsResult = Nothing
'
Application.ScreenUpdating = True

End Sub

Sa ne fonctionne toujours pas je pense qu'il y a une erreur avec "Som(1 + (x * 6)" car je me retrouve a avoir x=10 quand la macro bloque, je ne comprends pas à quel moment elle peut prendre cette valeur.

Florian,

comment veux-tu que nous comprenions ? Le fichier n'est pas complet !

Le code fait référence à des feuilles que l'on ne peut pas voir!

Une description sommaire de ce que tu veux faire nous aiderait aussi!

A+

Voici un exemple, qui je l’espère sera plus détaillé


Ton code fonctionne bien, mais il ne s'applique seulement à la colonne active, alors que je voudrais du'il s'applique de la colonne "C" à dernière colonne rempli en fonction de la ligne "1"

Salut Florian,

Je navigue toujours à vue... les feuilles que tu m'as fournies sont quasi vides d'info que l'on ne peut deviner!

Il fonctionne ? Etonnant !

Je remarque que tu testes tabBDD(y, 23) alors que ce tableau ne compte que 21 colonnes!

J'ai nommé ta feuille de résultats 'ASS Costs'.

Tes critères (crit1-4) : certains sont numériques et le 2 est alphanumérique si j'ai bien vu. Je teste donc une concaténation ( & ) des critères plutôt qu'une addition, forcément.

J'allais oublier : dans le code ci-dessous, la partie originale d'affectation des Som() est en commentaire avec tes valeurs.

La partie effective, si tu regardes bien, n'a pas les mêmes indices. J'ai réduit chacun de 2 ce qui correspond à l'erreur de 2 indices de ton tableau tabBDD. Vérifie deux fois plutôt qu'une!

A tester! Je n'ai pas la matière pour le faire!

Sub SommeASS()
'
Dim sWkBDD As Worksheet
Dim sWkASS As Worksheet
Dim tabBDD()
Dim Som(19) As Long, iCol As Integer
Dim crit1, crit2, crit3, crit4
'
Set sWkBDD = Worksheets("BDD")
Set sWkASS = Worksheets("ASS Costs")
'
With sWkBDD
    iRow = Range("B" & Rows.Count).End(xlUp).Row
    tabBDD = .Range("B3:V" & iRow).Value
End With
'
Application.ScreenUpdating = False
'
With sWkASS
    crit1 = .Cells(2, 1) ' Electrical cook
    crit3 = .Cells(9, 1) 'Beverage
    crit4 = .Cells(15, 1) 'Food preparation
    '
    For iCol = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column
        crit2 = .Cells(1, iCol) ' Period
        '
        For y = 1 To UBound(tabBDD, 1)
            Select Case tabBDD(y, 1) & tabBDD(y, 21)
                Case Is = crit2 & crit1
                    x = 0
                Case Is = crit2 & crit3
                    x = 1
                Case Is = crit2 & crit4
                    x = 2
            End Select
            Som(1 + (x * 6)) = Som(1 + (x * 6)) + tabBDD(y, 9)
            Som(2 + (x * 6)) = Som(2 + (x * 6)) + tabBDD(y, 20)
            Som(3 + (x * 6)) = Som(3 + (x * 6)) + tabBDD(y, 10)
            Som(4 + (x * 6)) = Som(4 + (x * 6)) + tabBDD(y, 12) + tabBDD(y, 13) + tabBDD(y, 14) + tabBDD(y, 16) + tabBDD(y, 18)
            Som(5 + (x * 6)) = Som(5 + (x * 6)) + tabBDD(y, 17)
            Som(6 + (x * 6)) = Som(6 + (x * 6)) + tabBDD(y, 15)
            'Som(1 + (x * 6)) = Som(1 + (x * 6)) + tabBDD(y, 11)
            'Som(2 + (x * 6)) = Som(2 + (x * 6)) + tabBDD(y, 22)
            'Som(3 + (x * 6)) = Som(3 + (x * 6)) + tabBDD(y, 12)
            'Som(4 + (x * 6)) = Som(4 + (x * 6)) + tabBDD(y, 14) + tabBDD(y, 15) + tabBDD(y, 16) + tabBDD(y, 18) + tabBDD(y, 20)
            'Som(5 + (x * 6)) = Som(5 + (x * 6)) + tabBDD(y, 19)
            'Som(6 + (x * 6)) = Som(6 + (x * 6)) + tabBDD(y, 17)
        Next
        '
        For x = 1 To 18
            Select Case x
                Case 4, 10, 16
                    .Cells(x + 1, iCol) = .Cells(x, iCol) / Som(x)
                Case Else
                    .Cells(x + 1, iCol) = Som(x)
            End Select
        Next
    Next
End With
'
Set sWkBDD = Nothing
Set sWkASS = Nothing
'
Application.ScreenUpdating = True

End Sub

Encore une chose : applique-toi dans l'indentation de ton code! Tu te reliras toi-même plus facilement.

A+

Merci à toi de prendre du temps afin de m'aider,

Dans mon tableau "BDD" les valeurs sont jusqu'à la colonne "W" donc c'est bien la colonne 23, si je me trompe pas .

Pour ce qui est des critères , comme dans premier exemple je ne m'occupe pas des numériques ou alphanumérique, je les compare si elles sont identiques elles réponds au critères sinon, non.

Je croyais que ma 1er macro fonctionnait de la colonne "C" à dercol mais non en fait, je me suis trompé.

Par contre son fonctionnement est bon, les résultat sont correct sauf, qu'il faudrait quelle s'applique jusqu'à "dercol".

Je dispose d'une macro qui me remplie la ligne 1 avec choix dynamique, je peux avoir 4 à 10 choix dans la ligne1 de la Feuil1. Et apès je voudrais que s’exécute la macro en question .

Salut Florian,

reste en ligne qu'on puisse avancer!

Qu'est-ce qui est bon dans ma macro, finalement?

Avec des tableaux à moitié remplis, je navigue dans le brouillard...

A+

En fait quand je compare la tienne et la mienne les résultats ne sont pas les mêmes, et ta macro plante avec "Dépassement de capacité" à la ligne 11. Les résultats obtenus de la ligne 2 à 10 ne sont pas bons.

J'ai corrigé certaines choses... mais encore une fois, j'ai besoin de voir pour comprendre!

A vue, avec des tableaux à moitié vides, sans savoir de quoi il retourne, parfois, la logique ne suffit pas...

Sub SommeASS()
'
Dim sWkBDD As Worksheet
Dim sWkASS As Worksheet
Dim tabBDD()
Dim Som(19) As Double, iCol As Integer
Dim crit1, crit2, crit3, crit4
'
Set sWkBDD = Worksheets("BDD")
Set sWkASS = Worksheets("ASS Costs")
'
With sWkBDD
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    tabBDD = .Range("A3:W" & iRow).Value
End With
'
Application.ScreenUpdating = False
'
With sWkASS
    crit1 = .Cells(2, 1) ' Electrical cook
    crit3 = .Cells(9, 1) 'Beverage
    crit4 = .Cells(15, 1) 'Food preparation
    '
    For iCol = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column
        crit2 = .Cells(1, iCol) ' Period
        '
        For y = 1 To UBound(tabBDD, 1)
            Select Case tabBDD(y, 1) & tabBDD(y, 23)
                Case Is = crit2 & crit1
                    iIdx = 0
                Case Is = crit2 & crit3
                    iIdx = 1
                Case Is = crit2 & crit4
                    iIdx = 2
            End Select
            Som(1 + (iIdx * 6)) = Som(1 + (iIdx * 6)) + tabBDD(y, 11)
            Som(2 + (iIdx * 6)) = Som(2 + (iIdx * 6)) + tabBDD(y, 22)
            Som(3 + (iIdx * 6)) = Som(3 + (iIdx * 6)) + tabBDD(y, 12)
            Som(4 + (iIdx * 6)) = Som(4 + (iIdx * 6)) + tabBDD(y, 14) + tabBDD(y, 15) + tabBDD(y, 16) + tabBDD(y, 18) + tabBDD(y, 20)
            Som(5 + (iIdx * 6)) = Som(5 + (iIdx * 6)) + tabBDD(y, 19)
            Som(6 + (iIdx * 6)) = Som(6 + (iIdx * 6)) + tabBDD(y, 17)
        Next
        '
        For x = 1 To 18
            Select Case x
                Case 4, 10, 16
                    If Som(x) > 0 Then .Cells(x + 1, iCol) = .Cells(x, iCol) / Som(x)
                Case Else
                    .Cells(x + 1, iCol) = Som(x)
            End Select
        Next
    Next
    .Columns("A:M").AutoFit
End With
'
Set sWkBDD = Nothing
Set sWkASS = Nothing
'
Application.ScreenUpdating = True

End Sub

J'ai remis ton tableau à 23 indices. C'est toi qui avait raison sur ce coup-là!

J'ai des Som() à zéro d'où dépassement de capacité car division par zéro.

A+

Merci à toi , les valeurs ne correspondent toujours pas. je mets en pièce jointe un fichier plus rempli si vous voulez mieux comprendre

Il n'y a pas de fichier, Florian!

Je viens de faire ce code qui fonctionne sur toutes les colonnes mais pas très simplifié

Dim Nlgn As Integer
Dim tabBDD()
Dim wsBDD As Object
Dim wsResult As Object

Dim som1, som2, som3, som4, som5, som6, som7, som8, som9, som10, som11, som12, som13, som14, som15, som16, som17, som18
Dim crit1, crit2, crit3, crit4
Dim cptBDD
Dim i As Integer

dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column

For Nlgn = 3 To dercol

    Set wsBDD = Worksheets("BDD")
    Set wsResult = Worksheets("ASS Costs")

    With wsBDD
        tabBDD = Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 23))
    End With

    With wsResult

    som1 = 0
    som2 = 0
    som3 = 0
    som4 = 0
    som5 = 0
    som6 = 0
    som7 = 0
    som8 = 0
    som9 = 0
    som10 = 0
    som11 = 0
    som12 = 0
    som13 = 0
    som14 = 0
    som15 = 0
    som16 = 0
    som17 = 0
    som18 = 0

        Application.ScreenUpdating = False

        crit1 = .Cells(2, 1)
        crit2 = .Cells(1, Nlgn)
        crit3 = .Cells(8, 1)
        crit4 = .Cells(14, 1)

        For cptBDD = 1 To UBound(tabBDD, 1)
            If (tabBDD(cptBDD, 23) = crit1) And (tabBDD(cptBDD, 1) = crit2) Then
                som1 = som1 + tabBDD(cptBDD, 11)
                som2 = som2 + tabBDD(cptBDD, 22)
                som3 = som3 + tabBDD(cptBDD, 12)
                som4 = som4 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som5 = som5 + tabBDD(cptBDD, 19)
                som6 = som6 + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit3) And (tabBDD(cptBDD, 1) = crit2) Then
                som7 = som7 + tabBDD(cptBDD, 11)
                som8 = som8 + tabBDD(cptBDD, 22)
                som9 = som9 + tabBDD(cptBDD, 12)
                som10 = som10 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som11 = som11 + tabBDD(cptBDD, 19)
                som12 = som12 + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit4) And (tabBDD(cptBDD, 1) = crit2) Then
                som13 = som13 + tabBDD(cptBDD, 11)
                som14 = som14 + tabBDD(cptBDD, 22)
                som15 = som15 + tabBDD(cptBDD, 12)
                som16 = som16 + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                som17 = som17 + tabBDD(cptBDD, 19)
                som18 = som18 + tabBDD(cptBDD, 17)
            End If

        Next
        .Cells(2, Nlgn) = som1
        .Cells(3, Nlgn) = som2
        .Cells(4, Nlgn) = (.Cells(3, Nlgn) / som3)
        .Cells(5, Nlgn) = som4
        .Cells(6, Nlgn) = som5
        .Cells(7, Nlgn) = som6
        .Cells(8, Nlgn) = som7
        .Cells(9, Nlgn) = som8
        .Cells(10, Nlgn) = (.Cells(9, Nlgn) / som9)
        .Cells(11, Nlgn) = som10
        .Cells(12, Nlgn) = som11
        .Cells(13, Nlgn) = som12
        .Cells(14, Nlgn) = som13
        .Cells(15, Nlgn) = som14
        .Cells(16, Nlgn) = (.Cells(15, Nlgn) / som15)
        .Cells(17, Nlgn) = som16
        .Cells(18, Nlgn) = som17
        .Cells(19, Nlgn) = som18

    End With

    Set wsBDD = Nothing
    Set wsResult = Nothing

    Next Nlgn

    Application.ScreenUpdating = True

Eh bien, on n'est pas sorti de l'auberge!

Ton fichier est inutilisable et le code que tu m'as envoyé recèle les mêmes erreurs que le mien... forcément avec des tableaux vides!

Envoie-moi ton "vrai" fichier à l'adresse mail que je t'ai laissée en message privé, stp!

A+

Rechercher des sujets similaires à "simplification vba"