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
|
Option Explicit
Sub Essai_Electrique_modelage()
Dim zero As Range 'Variable qui permet de trouver et de copier à la suite
Dim Essais As Variant ' Déclaration tableau
Dim firstAddress As String
Dim Essaidep As String 'Variable qui renvoie l'essai
Dim Essainom As String 'Variable qui renvoie l'essai à n+1
Dim Error As Integer
Dim Error2 As Integer
Dim Essaizero As String
Dim derligne As Integer
Dim i As Integer
Dim lastname As String
Dim Suiv As Range
Dim secondAddress As String
'Ecriture du tableau recompiler
Essais = Array("Nom de l'essais", "Emplacement", "Durée Te(min)", "Dépendance", "Support", "Sous-tension")
Cells(1, 12) = Essais(0)
Cells(1, 13) = Essais(1)
Cells(1, 14) = Essais(2)
Cells(1, 15) = Essais(3)
Cells(1, 16) = Essais(4)
derligne = Range("G" & Rows.Count).End(xlUp).Row
'Trouve la ligne de l'essai correspondant à la dep=0
With ActiveSheet
Set Suiv = Columns(7).Find(what:=0, LookIn:=xlValues, LookAt:=xlWhole)
If Not Suiv Is Nothing Then
secondAddress = Suiv.Address
Do
Range(Range(Suiv, Suiv(1, 0)).End(xlToLeft), Range(Suiv, Suiv(1, 0)).End(xlToRight)).Select
Selection.Copy Destination:=Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
Essaizero = Range("L" & Rows.Count).End(xlUp).Value
Essaidep = Essaizero
'Ecris dans le tableau les essais dont dépend l'essai à dépendance 0
Set zero = Columns(7).Find(what:=Essaidep, LookIn:=xlValues, LookAt:=xlWhole)
If Not zero Is Nothing Then
Do
firstAddress = zero.Address
If Not zero Is Nothing Then Range(Range(zero, zero(1, 0)).End(xlToLeft), Range(zero, zero(1, 0)).End(xlToRight)).Select
Selection.Copy Destination:=Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
Set zero = Columns(7).FindNext(zero)
Loop While Not zero Is Nothing And zero.Address <> firstAddress
End If
'trouve le nom de l'essai correspondant à l'essai à dépendance n+1
Essainom = Range("L" & Rows.Count).End(xlUp).Value
Set zero = Columns(7).Find(what:=Essainom, LookIn:=xlValues, LookAt:=xlWhole)
If Not zero Is Nothing Then
firstAddress = zero.Address
Do
If Not zero Is Nothing Then Range(Range(zero, zero(1, 0)).End(xlToLeft), Range(zero, zero(1, 0)).End(xlToRight)).Select
Selection.Copy Destination:=Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
Set zero = Columns(7).FindNext(zero)
Loop While Not zero Is Nothing And zero.Address <> firstAddress
End If
For i = 5 To derligne
lastname = Range("L" & Rows.Count).End(xlUp).Value
Set zero = Columns(7).Find(what:=lastname, LookIn:=xlValues, LookAt:=xlWhole)
If Not zero Is Nothing Then
firstAddress = zero.Address
Do
If Not zero Is Nothing Then Range(Range(zero, zero(1, 0)).End(xlToLeft), Range(zero, zero(1, 0)).End(xlToRight)).Select
Selection.Copy Destination:=Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
Set zero = Columns(7).FindNext(zero)
Loop While Not zero Is Nothing And zero.Address <> firstAddress
End If
Next
Set Suiv = Columns(7).FindNext(Suiv)
Loop While Not Suiv Is Nothing And Suiv.Address <> secondAddress
End If
End With
End Sub |
Partager