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,