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 !

Florian53

XLDnaute Impliqué
Bonsoir à 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:

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

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

VB:
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,

Une piste avec un tableau :
Code:
Sub SommeReportingQE()

    Dim Nlgn As Integer
    Dim tabBDD()
    Dim wsBDD As Object
    Dim wsResult As Object
    Dim TblSom(1 To 18) As Double
    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
        
        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
                TblSom(1) = TblSom(1) + tabBDD(cptBDD, 11)
                TblSom(2) = TblSom(2) + tabBDD(cptBDD, 22)
                TblSom(3) = TblSom(3) + tabBDD(cptBDD, 12)
                TblSom(4) = TblSom(4) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                TblSom(5) = TblSom(5) + tabBDD(cptBDD, 19)
                TblSom(6) = TblSom(6) + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit3) And (tabBDD(cptBDD, 1) = crit2) Then
                TblSom(7) = TblSom(7) + tabBDD(cptBDD, 11)
                TblSom(8) = TblSom(8) + tabBDD(cptBDD, 22)
                TblSom(9) = TblSom(9) + tabBDD(cptBDD, 12)
                TblSom(10) = TblSom(10) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                TblSom(11) = TblSom(11) + tabBDD(cptBDD, 19)
                TblSom(12) = TblSom(12) + tabBDD(cptBDD, 17)
            End If
            If (tabBDD(cptBDD, 23) = crit4) And (tabBDD(cptBDD, 1) = crit2) Then
                TblSom(13) = TblSom(13) + tabBDD(cptBDD, 11)
                TblSom(14) = TblSom(14) + tabBDD(cptBDD, 22)
                TblSom(15) = TblSom(15) + tabBDD(cptBDD, 12)
                TblSom(16) = TblSom(16) + tabBDD(cptBDD, 14) + tabBDD(cptBDD, 15) + tabBDD(cptBDD, 16) + tabBDD(cptBDD, 18) + tabBDD(cptBDD, 20)
                TblSom(17) = TblSom(17) + tabBDD(cptBDD, 19)
                TblSom(18) = TblSom(18) + tabBDD(cptBDD, 17)
            End If
          
        Next
       
        For I = 2 To 19
            Select Case I
                Case 4, 10, 16
                    .Cells(I, Nlgn) = (.Cells(I - 3, Nlgn) / TblSom(I - 1))
                Case Else
                    .Cells(I, Nlgn) = TblSom(I)
            End Select
        Next I
     
    End With
  
    Set wsBDD = Nothing
    Set wsResult = Nothing
  
    Application.ScreenUpdating = True
  
End Sub
 
- 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

Réponses
2
Affichages
201
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Réponses
1
Affichages
520
Réponses
0
Affichages
459
Réponses
2
Affichages
511
Réponses
3
Affichages
508
Réponses
9
Affichages
893
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
Retour