difficultés conditions multiples Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
C
CP4
Membre fidèle
Membre fidèle
Messages : 219
Appréciations reçues : 3
Inscrit le : 22 mars 2014
Version d'Excel : 2010

Message par CP4 » 4 avril 2014, 16:20

Bonjour,
http://cjoint.com/?0DeqtvEPQ07

Pour alimenter un tableau récapitulatif à partir d'une BD, j’ai fait une macro qui fonctionne avec des imperfections. Je trouve des difficultés pour mettre en place des conditions.
Je mets en place des autos filtres successifs, récupère certaines données et effectue des calculs pour les renvoyer sur la feuille « TxBord ». J’ai utilisé la fonction sous.total appliquée à des lignes filtrées.
Pour ce travail, seules les types M et M/A sont concernés (col R de la feuille BD)
En règle générale, quand le type est M la col I de la feuille BD (VAL9) est renseignée et la col J est vide ; quand le type est M/A normalement les 2 colonne I et J sont renseignées mais il peut y avoir des cas particuliers où le col J est vide. (Je dois mettre des conditions pour le calcul)
Le tableau de destination (sur feuille TxBord) se présente comme suit :
Col B, C et D : Données récupérées via dictionnaires
Col E : moyenne col I de la feuille BD
Col F : moyenne col J de la feuille BD
Col G : (a=somme col O (val15) dont col H= S ou S/I)- (b=somme col O (val15) dont col H= I ou adf)
Col J : valeur Max –valeur Min de la colonne G de la feuille BD (VAL7)
Col H : densité =valeur col G/(valeur col D convertie en m *Pi*valeur col J
Col I= (valeur col E – valeur col F)/valeur colH

La difficulté est quand le type est M/A et que la colonne J (VAL10) est vide, et que val4=N2 [temp(i)=N2] et val6=24 [temp2(j)=24], la cellule correspondante en colonne I doit être vide.
 Option Explicit
 Dim a, b, d, e, f, g, Em, dens, som, N2, temp, temp2
 
Sub Tx_Bord()
Dim i As Long, J As Long, k As Long, NBd As Long, NCr As Long, dl As Long, LaDate As Long, x As Long, y As Long
Dim TypeCamp As String, DerLig As Long
Dim ShBd As Worksheet, ShTxB As Worksheet
Dim Plage As Range, C As Range, v As Range
Dim tOuv As Object, tTrc As Object
Dim temp As Variant, temp1 As Variant, temp2 As Variant
Dim Ligne, N2 As String, Chaine As String

Application.ScreenUpdating = False
 
Set ShBd = Worksheets("BD")
ShBd.AutoFilterMode = False
NBd = ShBd.Cells(ShBd.Rows.Count, 1).End(xlUp).Row
  
Set ShTxB = Worksheets("TxBord")
With ShTxB
    dl = .Cells(.Rows.Count, 2).End(xlUp).Row
    If dl > 4 Then .Range("A5:L" & dl).Rows.Delete
    LaDate = .Range("C1")                    'DATE
    TypeCamp = .Range("H1")                   'REFERENCE
    
    With ShBd
            '.AutoFilterMode = False
            .Range("A1:AA" & NBd).AutoFilter Field:=18, Criteria1:=TypeCamp
            .Range("A1:AA" & NBd).AutoFilter Field:=3, Criteria1:=CDate(LaDate)
             
            Set tOuv = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
            For Each C In .Range("D2:D" & NBd).SpecialCells(xlCellTypeVisible)
            tOuv(C.Value) = ""
            Next C 'prochaine cellule de la boucle
            temp = tOuv.keys 'récupère le dictionnaire sans doublon dans le tableau temp
            For i = 0 To UBound(temp) 'boucle 1 : sur toutes les valeurs uniques du tableau temp

               .Range("A1:AA" & NBd).AutoFilter Field:=4, Criteria1:=temp(i)    'autofiltre1 /VAL4 (colD)
              
                Set tTrc = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
                Set Plage = .Range("E2:E" & NBd).SpecialCells(xlCellTypeVisible)
                For Each C In Plage 'c In .Range("E2:E" & NBd).SpecialCells(xlCellTypeVisible)
                If Not tTrc.Exists(C.Value) Then tTrc.Add C.Value, C.Offset(0, 1).Value
                Next C 'prochaine cellule de la boucle
                temp1 = tTrc.keys 'récupère le dictionnaire sans doublon dans le tableau temp
                temp2 = tTrc.items
                For J = 0 To UBound(temp1) 'boucle 1 : sur toutes les valeurs uniques du tableau temp

                    .Range("A1:AA" & NBd).AutoFilter Field:=5, Criteria1:=temp1(J)  'autofiltre2 /VAL5 (colE)

                 DerLig = ShTxB.Cells.Find("*", , , , xlByRows, xlPrevious).Row
                  
                          ShTxB.Cells(DerLig + 1, 2) = temp(i) 'VAL4 sur TxBord colB
                          ShTxB.Cells(DerLig + 1, 3) = temp1(J) 'VAL5 sur TxBord colC
                          ShTxB.Cells(DerLig + 1, 4) = temp2(J) 'VAL6 sur TxBord colD

                          'calcul moyenne col I
                          ShTxB.Cells(DerLig + 1, 5) = WorksheetFunction.Subtotal(101, ShBd.Range("I1:I" & NBd)) 'MOY VAL9
                          ShTxB.Cells(DerLig + 1, 5).NumberFormat = "#,##0"
                          Em = ShTxB.Cells(DerLig + 1, 5).Value 'on affecte valeur pour la réutiliser
          
                            som = WorksheetFunction.Subtotal(109, ShBd.Range("J1:J" & NBd))
                                    
                          
                          If ShTxB.Range("H1") = "M" Or som = 0 Then GoTo 1 'n'effectue pas la moy col J (bon)
                          
                          ShTxB.Cells(DerLig + 1, 6) = WorksheetFunction.Subtotal(101, ShBd.Range("J1:J" & NBd)) 'MOY VAL10
                          ShTxB.Cells(DerLig + 1, 6).NumberFormat = "#,##0"
                          
1
                            ' nouveau filtre pour somme1-somme2 (VAL15) Col O
                            .Range("A1:AA" & NBd).AutoFilter Field:=8, Criteria1:="=S", _
                          Operator:=xlOr, Criteria2:="=S/I"
                            
                            a = WorksheetFunction.Subtotal(109, ShBd.Range("O1:O" & NBd))
                            
                            'autofiltre VAL8 col H
                            .Range("A1:AA" & NBd).AutoFilter Field:=8, Criteria1:="=I", _
                            Operator:=xlOr, Criteria2:="=ADF"
                            
                            'autofiltre VAL11 col K (cellule vide)
                            .Range("A1:AA" & NBd).AutoFilter Field:=11, Criteria1:="="
                                
                            b = WorksheetFunction.Subtotal(109, ShBd.Range("O1:O" & NBd))
                                
                                ShTxB.Cells(DerLig + 1, 7) = a - b
                                ShTxB.Cells(DerLig + 1, 7).NumberFormat = "#,##0"" mA"""
                                
                                'on supprime autofiltre
                                .Range("A1:AA" & NBd).AutoFilter Field:=11
                                .Range("A1:AA" & NBd).AutoFilter Field:=8
                            
                            ShTxB.Cells(DerLig + 1, 10) = WorksheetFunction.Subtotal(104, ShBd.Range("G1:G" & NBd)) _
                          - WorksheetFunction.Subtotal(105, ShBd.Range("G1:G" & NBd)) 'max-min filtrer
                            ShTxB.Cells(DerLig + 1, 10).NumberFormat = "#,##0.00"
                             
                             d = ShTxB.Cells(DerLig + 1, 10).Value 'longueur VAL7 Col G
                             
                                                    
                        If temp(i) <> N2 And temp2(J) <> 24 Then
                             
                            ShTxB.Cells(DerLig + 1, 8) = (a - b) / (WorksheetFunction.Pi() * _
                            (WorksheetFunction.Convert(temp2(J), "in", "m") * d))
                            dens = ShTxB.Cells(DerLig + 1, 8).Value
                            ShTxB.Cells(DerLig + 1, 8).NumberFormat = "0.00"" µA/m²"""
                            ShTxB.Cells(DerLig + 1, 8).VerticalAlignment = xlCenter
                        Else
                            ShTxB.Cells(DerLig + 1, 8) = ((a - b) / (WorksheetFunction.Pi() * _
                            (WorksheetFunction.Convert(temp2(J), "in", "m") * d))) / 3 '
                            ShTxB.Cells(DerLig + 1, 8).NumberFormat = "0.00"" µA/m²"""
                            ShTxB.Cells(DerLig + 1, 8).VerticalAlignment = xlCenter
                        End If
'difficulté rencontrée ici'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                        ' conditions à mettre en place
                        'si ShTxB.Range("H1") = "M" Or som = 0 (somme colonne J)
                        'ou si temp(i)=N2 et temp2(j)=24
                        'alors cellule correspondante en col 9=vide
                        
                        If (ShTxB.Range("H1") = "M" Or som = 0) Or (temp(i) = N2 And temp2(J) = 24) Then
                        'pour mettre l'unité
                           ShTxB.Cells(DerLig + 1, 9) = ""
                           Else
                            Chaine = "#,##0" & Chr(34) & Chr(32) & ChrW(937) & ".m²" & Chr(34)
                            
                            g = ((Em * -1000) / dens)
                            ShTxB.Cells(DerLig + 1, 9) = g
                            ShTxB.Cells(DerLig + 1, 9).NumberFormat = Chaine '
                           'Else
                           'ShTxB.Cells(DerLig + 1, 9) = ""
                          End If
                           
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                            e = WorksheetFunction.Subtotal(103, ShBd.Range("I1:I" & NBd)) 'nbval filter
                            
                            .Range("A1:AA" & NBd).AutoFilter Field:=9, Criteria1:="<=-600"
                            f = WorksheetFunction.Subtotal(103, ShBd.Range("I1:I" & NBd))
                            .Range("A1:AA" & NBd).AutoFilter Field:=9

                          ShTxB.Cells(DerLig + 1, 11) = (f / e)
                          ShTxB.Cells(DerLig + 1, 11).NumberFormat = "0%"
                          
                          ShTxB.Cells(DerLig + 1, 12) = "" 'observation
                          
                            ShTxB.Cells.Range("B5:L" & DerLig + 1).Borders.Weight = xlThin
                 Next J
                 .Range("A1:AA" & NBd).AutoFilter Field:=5
            Next i
                      
            .AutoFilterMode = False
            
        End With
        
        ShTxB.Columns("C:C").EntireColumn.AutoFit
 End With
Set ShBd = Nothing
Set ShTxB = Nothing
End Sub
J’ai eu beau tourné et retourner le problème, je ne pas parviens à allier ces conditions.

En espérant avoir été clair, je vous remercie beaucoup.
C
CP4
Membre fidèle
Membre fidèle
Messages : 219
Appréciations reçues : 3
Inscrit le : 22 mars 2014
Version d'Excel : 2010

Message par CP4 » 4 avril 2014, 23:42

Bonsoir,

Il me semble que j'ai très mal exposé mon problème, je vais essayer d'être plus clair.

Après avoir appliquer 2 autofiltres sur le feuille BD, je récupère des données dans 2 dictionnaires pour effectuer des boucles de filtrage, temp(i) et temp(j).

Sur la feuille TxBord, je voudrai dans la colonne de destination (Col9) soit vide si la colonne J de la feuille BD est vide, ainsi que pour le cas particulier suivant: temp(i)=N2 and temp2(j)=24 et ce, que la colonne J soit vide ou pleine.

Pour tous les autres cas ShTxB.Cells(DerLig + 1, 9) = g, avec g = ((Em * -1000) / dens).

Je patauge depuis un bon bout de temps sans parvenir à trouver une solution.

Je vous remercie par avance. Bon week-end à tous.

Cordialement,
C
CP4
Membre fidèle
Membre fidèle
Messages : 219
Appréciations reçues : 3
Inscrit le : 22 mars 2014
Version d'Excel : 2010

Message par CP4 » 5 avril 2014, 09:55

Bonjour,

Je pense avoir trouvé la solution. Il fallait que je mette la condition sur la concaténation des 2 variables temp(i) et temp2(j).
If Som = 0 Or temp(i) & temp2(J) = "N224" Then
 ShTxB.Cells(DerLig + 1, 9) = ""
 Else
 g = ((Em * -1000) / dens)
 ShTxB.Cells(DerLig + 1, 9) = g
 End If
Mon problème est résolu. Merci à tous ceux qui ont consulté mon message.

Cordialement,
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Conditions multiples
    par goam » 8 août 2019, 12:21 » dans Excel - VBA
    4 Réponses
    293 Vues
    Dernier message par goam
    8 août 2019, 15:47
  • Conditions multiples !
    par SAER » 1 avril 2020, 21:13 » dans Excel - VBA
    7 Réponses
    88 Vues
    Dernier message par tulipe_4
    2 avril 2020, 18:41
  • Conditions Multiples
    par Steve99 » 28 avril 2020, 22:08 » dans Excel - VBA
    4 Réponses
    29 Vues
    Dernier message par JoyeuxNoel
    28 avril 2020, 22:21
  • Conditions multiples
    par AlexisD » 27 décembre 2018, 16:07 » dans Excel - VBA
    4 Réponses
    102 Vues
    Dernier message par Nathalie Charette
    27 décembre 2018, 17:00
  • Conditions multiples
    par ACCLPC » 30 septembre 2014, 18:21 » dans Excel - VBA
    5 Réponses
    437 Vues
    Dernier message par mbbp
    30 septembre 2014, 18:51
  • Conditions Multiples
    par Laurent59 » 1 novembre 2014, 22:24 » dans Excel - VBA
    5 Réponses
    379 Vues
    Dernier message par Laurent59
    2 novembre 2014, 14:16