Option Explicit
Sub Traitement()
Dim Lastlig As Long
Dim Tb, Tablo, Tp
Dim Ind As Byte
Application.ScreenUpdating = False
With Worksheets("BD")
'Dernière ligne remplie de la colonne 1
Lastlig = .Cells(.Rows.Count, 1).End(xlUp).Row
'On récupère les données dans une variable tableau Tb
Tb = .Range("A2:J" & Lastlig)
End With
'Ici on supprime les feuilles Beta et Delta (si elles existent)
Tp = Array("Beta", "Delta")
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(Tp).Delete
On Error GoTo 0
Application.DisplayAlerts = False
'Pour chaque valeur du tableau Tp (Beta ou Delta) on ajoute une feuille qu'on nomme et dans laquelle on transfère les résultats escomptés
'à l'aide de la fonction Dispatch (expliquée ci-après)
For Ind = 0 To 1
Tablo = Dispatch(Tb, Tp(Ind))
With Worksheets.Add
.Name = UCase(Tp(Ind))
.Range("A1") = Tp(Ind)
.Range("A7").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
.Range("A9").Resize(UBound(Tablo, 1) - 2, UBound(Tablo, 2)).Sort Key1:=.Range("A4"), order1:=xlAscending, Header:=xlNo
End With
Next Ind
End Sub
Private Function Dispatch(ByVal Tb, ByVal Typ As String)
Dim Ouvrage As Object
Dim PosteDirect As Object
Dim C As Integer, m As Integer, R As Integer, n As Integer
Dim p As Integer, i As Integer, j As Integer, k As Long
Dim Res(), Tmp, Vemp
Set Ouvrage = CreateObject("Scripting.Dictionary")
Set PosteDirect = CreateObject("Scripting.Dictionary")
'p: nombre de valeurs de la feuille BD
p = UBound(Tb, 1)
'=====================================
'Ici, à l'aide de 2 dictionnaires, on récupère les valeurs sans doublons et avec comme valeur de la colonne 2 la donnée paramètre Typ (qui sera Delta ou Beta):
'1. Dans le dictionnaire Ouvrage, tous les ouvrages différents de la colonne 3 (Colonne C)
'2. Dans le dictionnaire PosteDirect, tous les les postes concaténé aux direction colonne 4 (D) et colonne 9 (I)
For i = 1 To p
If Tb(i, 2) = Typ Then
Ouvrage(Tb(i, 3)) = ""
PosteDirect(Tb(i, 4) & "|" & Tb(i, 9)) = ""
End If
Next i
'=====================================
'C: Nombre d'ouvrages trouvés pour Type=typ
C = Ouvrage.Count
'm le nombre de colonnes, chaque ouvrage a 2 colonnes + 5 colonnes pour Poste, redresseur x 2 + direction + observations
m = 5 + 2 * C
'R: Nombre de combinaisons Poste/Direction trouvées pour Type=Typ
R = PosteDirect.Count
'n: nombre de lignes = R + 2 lignes entête
n = 2 + R
'On dimensionne notre tableau Resultat nommé Res de N lignes et m colonnes
ReDim Res(1 To n, 1 To m)
'on remplit les entêtes fixes (lignes 1 et 2)
Res(1, 1) = "N°Poste Localisation"
Res(1, 2) = "Redresseur"
Res(1, 3) = "Redresseur"
Res(2, 2) = "Tension (V)"
Res(2, 3) = "Courant (A)"
'=========== Modification =========================================
Dim tempOuvrage
Dim tempPosteDirect
tempOuvrage = Ouvrage.Keys
tempPosteDirect = PosteDirect.Keys
'==================================================================
'on remplit les entêtes variables correspondant aux ouvrages (chaque ouvrage et répété 2 fois)
For j = 0 To 2 * C - 1
k = Int(j / 2)
Res(1, j + 4) = tempOuvrage(k) 'Res(1, j + 4) = Ouvrage.Keys(k)
Res(2, 2 * k + 4) = "Potentiel (mV)"
Res(2, 2 * k + 5) = "Courant (mA)"
Next j
'on remplit les entêtes des 2 dernières colonnes
Res(1, m - 1) = "Direction"
Res(1, m) = "Observations (" & Typ & ")"
'Ici, on remplit pour chaqque cellule de notre tableau les données correspondantes
For i = 3 To n
'Dans la variable tableau Vemp on scinde notre combinaison Poste|Direction
Vemp = Split(tempPosteDirect(i - 3), "|") 'Vemp = Split(PosteDirect.Keys(i - 3), "|")
'La première colonne de Res correspond au poste
Res(i, 1) = Vemp(0)
' et l'avant dernière colonne correspond à la direction
Res(i, m - 1) = Vemp(1)
'ici on pracours pour chaque ligne i toutes les colonnes sauf la première et les 2 dernières
For j = 4 To m - 2 Step 2
k = Int((j - 4) / 2)
'la fonction Synthese est expliquée plus bas
Tmp = Synthese(Tb, Typ, Vemp(1), tempOuvrage(k), Res(i, 1)) 'Tmp = Synthese(Tb, Typ, Vemp(1), Ouvrage.Keys(k), Res(i, 1))
If Res(i, 2) = "" Then Res(i, 2) = Tmp(0)
If Res(i, 3) = "" Then Res(i, 3) = Tmp(1)
Res(i, j) = Tmp(2)
Res(i, j + 1) = Tmp(3)
Res(i, m) = Res(i, m) & "" & Tmp(5)
Next j
Next i
Set Ouvrage = Nothing
Set PosteDirect = Nothing
Dispatch = Res
End Function
'Ici cette fonction fait la synthèse du tableau initial Tb (corespondant à la feuille BD)
'Pour chaque Type, chaque Direction,chaque ouvrage et chaque poste, récupèrer les informations suivantes
'Tension Courant Potentiel Courant_Inj Direction Observation
Private Function Synthese(ByVal Tb, ByVal Typ As String, ByVal Dire As String, ByVal Ouv As String, ByVal Post As String)
Dim Tablo(0 To 5)
Dim i As Integer
Dim t As Byte
For i = 1 To UBound(Tb, 1)
If Tb(i, 2) = Typ And Tb(i, 3) = Ouv And Tb(i, 4) = Post And Tb(i, 9) = Dire Then
For t = 0 To 5
Tablo(t) = Replace(Tb(i, 5 + t), Chr(10), " ")
Next t
Exit For
End If
Next i
Synthese = Tablo
End Function
