cathodique
XLDnaute Barbatruc
Bonsoir, http://cjoint.com/?0CrthDt22KS
Avant d'exposer mon problème, je dois vous dire que j'ai posté cette discussion sur un autre Forum. Par rapport à l'avancement, je donnerai à l'un et à l'autre de toutes réponses pour le partage.
Ma première approche a été les auto-filtres, j'utilise un userform pour effectue la sélection d'un type et d'une date, toute la suite sera traitée par rapport à ces 2 critères qui sont transférés sur la feuille TxBord.
Voilà, afin de faire une espèce de tableau de bord, je dois extraire des données d'une BD et transférer celles-ci sur la feuille "TxBord", en effectuant un premier filtre dont les critères sont les valeurs VAL18=Sheets("TxBord").Range("H4") et VAL3=Sheets("TxBord").Range("D4")
J'ai fait une partie du code en utilisant des dictionnaires (que je ne maitrise pas très bien), je suis parvenu à extraire les valeurs de 3 colonnes VAL4, VAL5 et VAL6.
Pour les autres colonnes, il y a quelques calculs à faire, je commence par les plus simples:
1 - Pour VAL9 et VAL10 c'est la moyenne des colonnes correspondantes filtrées
2 - Pour VAL7, c'est la différence entre la plus valeur et la plus petite des lignes visibles (à partir 2ème ligne visible)
3- Pour %VAL, c'est le ration entre le nombre de cellules (VAL10) dont la valeur est <=-600 et le nombre de cellules non vides de la même colonne (VAL10)
4 - Pour VAL15, ça se complique un peu, sommer les valeurs (val15) pour lesquelles VAL8= "S" ou "PS ou "CPS" à laquelle il faudra soustraire la somme des cellules dont en colonne VAL8, il y aura "I" ou "ADF" ET dont la cellule correspondante en VAL11 est vide
5 - Pour densité, elle se calcule ainsi: Résultat pour VAL19/(Pi*(Convert(VAL6,"in","m"))*VAL7)
En vous remerciant, j'ai commencé avec les dictionnaires mais toutes autres approches sera la bienvenue.
Je vous avoue que je suis un peu septique que mon code aboutisse tel que je l'ai commencé. Et ce, par rapport à toutes les recherches que j'ai effectué et les différentes discussions que j'ai consulté.
Cordialement,
Avant d'exposer mon problème, je dois vous dire que j'ai posté cette discussion sur un autre Forum. Par rapport à l'avancement, je donnerai à l'un et à l'autre de toutes réponses pour le partage.
Ma première approche a été les auto-filtres, j'utilise un userform pour effectue la sélection d'un type et d'une date, toute la suite sera traitée par rapport à ces 2 critères qui sont transférés sur la feuille TxBord.
Voilà, afin de faire une espèce de tableau de bord, je dois extraire des données d'une BD et transférer celles-ci sur la feuille "TxBord", en effectuant un premier filtre dont les critères sont les valeurs VAL18=Sheets("TxBord").Range("H4") et VAL3=Sheets("TxBord").Range("D4")
J'ai fait une partie du code en utilisant des dictionnaires (que je ne maitrise pas très bien), je suis parvenu à extraire les valeurs de 3 colonnes VAL4, VAL5 et VAL6.
Pour les autres colonnes, il y a quelques calculs à faire, je commence par les plus simples:
1 - Pour VAL9 et VAL10 c'est la moyenne des colonnes correspondantes filtrées
2 - Pour VAL7, c'est la différence entre la plus valeur et la plus petite des lignes visibles (à partir 2ème ligne visible)
3- Pour %VAL, c'est le ration entre le nombre de cellules (VAL10) dont la valeur est <=-600 et le nombre de cellules non vides de la même colonne (VAL10)
4 - Pour VAL15, ça se complique un peu, sommer les valeurs (val15) pour lesquelles VAL8= "S" ou "PS ou "CPS" à laquelle il faudra soustraire la somme des cellules dont en colonne VAL8, il y aura "I" ou "ADF" ET dont la cellule correspondante en VAL11 est vide
5 - Pour densité, elle se calcule ainsi: Résultat pour VAL19/(Pi*(Convert(VAL6,"in","m"))*VAL7)
En vous remerciant, j'ai commencé avec les dictionnaires mais toutes autres approches sera la bienvenue.
Je vous avoue que je suis un peu septique que mon code aboutisse tel que je l'ai commencé. Et ce, par rapport à toutes les recherches que j'ai effectué et les différentes discussions que j'ai consulté.
Cordialement,
Code:
Option Explicit
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
Dim ShBd As Worksheet, ShTxB As Worksheet
Dim Plage As Range, C As Range, v As Range
Dim Prise(), Ouvrage(), Tronçon()
Dim tOuv As Object, tTrc As Object
Dim temp As Variant, temp1 As Variant, temp2 As Variant
Dim Ligne
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 > 7 Then .Range("A8:K" & DL).Clear
LaDate = .Range("C4") 'DATE
TypeCamp = .Range("H4") '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
'Stop
.Range("A1:AA" & NBd).AutoFilter Field:=4, Criteria1:=temp(i)
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)
' Stop
ShTxB.Cells(J + 8, 2) = temp(i) 'solution trouvée
ShTxB.Cells(J + 8, 3) = temp1(J) 'solution trouvée
ShTxB.Cells(J + 8, 4) = temp2(J) 'solution trouvée
ShTxB.Cells(J + 8, 5) = "" 'solution non trouvée, moyenne cellules visibles col9
ShTxB.Cells(J + 8, 6) = "" 'solution non trouvée, moyenne cellules visibles col10
ShTxB.Cells(J + 8, 6) = "" 'solution non trouvée
ShTxB.Cells(J + 8, 7) = "" 'solution non trouvée
ShTxB.Cells(J + 8, 8) = "" 'solution non trouvée
ShTxB.Cells(J + 8, 9) = "" 'solution non trouvée
ShTxB.Cells(J + 8, 10) = "" 'solution non trouvée
Next J
Next i
.AutoFilterMode = False
End With
End With
Set ShBd = Nothing
Set ShTxB = Nothing
End Sub
Dernière édition:
.
