1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
| Option Explicit
Option Base 1
Sub Calcul()
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim Feuille1 As String
Dim L_Titre1 As Long
Dim C_RepChemCab1 As Long
Dim C_RepCable1 As Long
Dim C_LargeurD1 As Long
Dim C_PremColonne1 As Long
Dim C_DerColonne1 As Long
Dim L_PremLigne1 As Long
Dim L_DerLigne1 As Long
Dim L_DerLigne As Long
Dim Feuille2 As String
Dim L_Titre2 As Long
Dim C_Dalle2 As Long
Dim C_PremColonne2 As Long
Dim C_DerColonne2 As Long
Dim L_PremLigne2 As Long
Dim L_DerLigne2 As Long
Dim Feuille3 As String
Dim L_DerLigne3 As Long
Dim Feuille4 As String
Dim Feuille5 As String
Dim C_RepCabTabMDB As Long
Dim C_PositionTabMDB As Long
Dim C_SectionTabMDB As Long
Dim C_LargeurCabTabMDB As Long
Dim C_RepChemCabTabMDB As Long
Dim C_RepDalleTabMDB As Long
Dim C_LargeurChemCabTabMDB As Long
Dim C_NbCabTabReserve As Long
Dim L_LargeurDTabReserve As Long
Dim Valeur As Integer
Dim Cible As Variant
Dim RepChemCabTabChemCab As String
Dim LargeurD As Long
Dim LargeurEncomb As Double
Dim LargeurDRes As Double
Dim NbCab As Long
Dim NbCircUni As Long
Dim NbCircMulti As Long
'Déclaration variable tableau
Dim Tablotmp1
Dim Tablotmp2
Dim TabMDB As Variant
Dim TabChemCab As Variant
Dim Ncol As Long
Dim clé As String
Dim d As Object
Dim TabReserve As Variant
Application.ScreenUpdating = False
Feuille1 = "MdB BAV MHSA"
Feuille2 = "Réserve"
Feuille3 = "Feuil2"
Feuille4 = "Feuil3"
Feuille5 = "Feuil4"
Sheets(Feuille1).Activate
If Worksheets(Feuille1).FilterMode Then
Worksheets(Feuille1).ShowAllData
Else
End If
L_Titre1 = Sheets(Feuille1).Cells.Find("RepereCable", lookat:=xlWhole).Row
C_RepCable1 = Sheets(Feuille1).Rows(L_Titre1).Find("RepereCable", lookat:=xlWhole).Column
C_RepChemCab1 = Sheets(Feuille1).Rows(L_Titre1).Find("RepereCheminCable", lookat:=xlWhole).Column
C_LargeurD1 = Sheets(Feuille1).Rows(L_Titre1).Find("LargeurCheminCable", lookat:=xlWhole).Column
L_PremLigne1 = 1
L_DerLigne1 = Sheets(Feuille1).Cells(Rows.Count, C_RepCable1).End(xlUp).Row
C_PremColonne1 = 1
C_DerColonne1 = Sheets(Feuille1).Rows(L_Titre1).Find("Local", lookat:=xlWhole).Column
L_Titre2 = Sheets(Feuille2).Cells.Find("Nb câbles", lookat:=xlWhole).Row
C_Dalle2 = Sheets(Feuille2).Rows(L_Titre2).Find("Dalles", lookat:=xlWhole).Column
L_PremLigne2 = 1
L_DerLigne2 = Sheets(Feuille2).Cells(Rows.Count, C_Dalle2).End(xlUp).Row
C_PremColonne2 = 1
C_DerColonne2 = Sheets(Feuille2).Cells(L_Titre2, Columns.Count).End(xlToLeft).Column
''''Tableau MDB
TabMDB = Range(Sheets(Feuille1).Cells(L_PremLigne1, C_PremColonne1), Sheets(Feuille1).Cells(L_DerLigne1, C_DerColonne1))
''''Numero de colonne pour info dans tableau MDB
For i = 1 To UBound(TabMDB, 2)
If TabMDB(1, i) = "RepereCable" Then
C_RepCabTabMDB = i
ElseIf TabMDB(1, i) = "Position" Then
C_PositionTabMDB = i
ElseIf TabMDB(1, i) = "Section" Then
C_SectionTabMDB = i
ElseIf TabMDB(1, i) = "LargeurCable" Then
C_LargeurCabTabMDB = i
ElseIf TabMDB(1, i) = "RepereCheminCable" Then
C_RepChemCabTabMDB = i
ElseIf TabMDB(1, i) = "RepereDalle" Then
C_RepDalleTabMDB = i
ElseIf TabMDB(1, i) = "LargeurCheminCable" Then
C_LargeurChemCabTabMDB = i
End If
Next i
''''Tri croissant sur le tableau TabMDB
Do 'tri décroissant
Valeur = 0
For i = UBound(TabMDB) To 1 Step -1
If TabMDB(i, C_LargeurCabTabMDB) < TabMDB(i - 1, C_LargeurCabTabMDB) And TabMDB(i - 1, C_LargeurCabTabMDB) <> "LargeurCable" Then
Cible = TabMDB(i)
TabMDB(i) = TabMDB(i - 1)
TabMDB(i - 1) = Cible
Valeur = 1
End If
Next i
Loop While Valeur = 1
'vérification du tri
Sheets(Feuille5).Cells(1, 1).Resize(UBound(TabMDB, 1), UBound(TabMDB, 2)) = TabMDB
Application.ScreenUpdating = True
End Sub |
Partager