Difficultés conditions multiples

Bonjour,

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.

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,

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,

Rechercher des sujets similaires à "difficultes conditions multiples"