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
| Sub MAJ_CALCUL2()
Dim num_ligne As Integer
Dim val_A As String
Dim val_B As String
Dim val_C As String
Dim val_D As String
Dim val_E As String
Dim val_F As String
Dim val_G As String
Dim val_H As String
Dim val_I As String
Dim groupe As String
Dim donnees_a_copier As Range
Worksheets(1).Activate
Range("A2").Select 'selection pour mettre la cellule active au bon endroit
num_ligne = ActiveCell.Row
If Not ActiveCell.Value = "" And num_ligne = 2 Then 'si le fichier n'est pas vide
Do Until ActiveCell.Value = "" 'Boucle tant qu'il y a des données
'récupération des valeurs des colonnes utiles (A à I)
val_A = ActiveCell.Value
val_B = ActiveCell.Offset(0, 1).Value 'le offset décale d'un cran sur la droite
val_C = ActiveCell.Offset(0, 2).Value
val_D = ActiveCell.Offset(0, 3).Value
val_E = ActiveCell.Offset(0, 4).Value
val_F = ActiveCell.Offset(0, 5).Value
val_G = ActiveCell.Offset(0, 6).Value
val_H = ActiveCell.Offset(0, 7).Value
val_I = ActiveCell.Offset(0, 8).Value
groupe = val_A & val_B & val_C & val_D & val_E & val_F & val_G & val_H & val_I
'appel à la fonction de récupération du calcul2
donnees_a_copier = Recuperer_Valeur_Calcul2(groupe)
'on réactive la feuille 1
Worksheets(1).Activate
'Copie_valeur_Calcul2()
If donnees_a_copier <> Nothing Then
ActiveCell.Range("J1:AM1").Select = donnees_a_copier
End If
ActiveCell.Offset(1, 0).Select 'selection des données de la ligne suivante
Loop
End If
End Sub
Function Recuperer_Valeur_Calcul2(groupe)
'on active la feuille 2
Worksheets(2).Activate
Range("A1").Select 'selection pour mettre la cellule active au bon endroit
'Boucle pour connaitre le nombre de ligne du fichier
Dim NbLigne As Integer
Dim val_A2 As String
Dim val_B2 As String
Dim val_C2 As String
Dim val_D2 As String
Dim val_E2 As String
Dim val_F2 As String
Dim val_G2 As String
Dim val_H2 As String
Dim val_I2 As String
Dim groupe2 As String
Do While Not (IsEmpty(ActiveCell))
NbLigne = NbLigne + 1
ActiveCell.Offset(1, 0).Select
Loop
If NbLigne > 1 Then 'si le fichier comporte des données
'On remet le curseur au bon endroit
Range("A2").Select
Do While (Not (IsEmpty(ActiveCell)) And groupe <> groupe2)
val_A2 = ActiveCell.Value
val_B2 = ActiveCell.Offset(0, 1).Value 'le offset décale d'un cran sur la droite
val_C2 = ActiveCell.Offset(0, 2).Value
val_D2 = ActiveCell.Offset(0, 3).Value
val_E2 = ActiveCell.Offset(0, 4).Value
val_F2 = ActiveCell.Offset(0, 5).Value
val_G2 = ActiveCell.Offset(0, 6).Value
val_H2 = ActiveCell.Offset(0, 7).Value
val_I2 = ActiveCell.Offset(0, 8).Value
groupe2 = val_A2 & val_B2 & val_C2 & val_D2 & val_E2 & val_F2 & val_G2 & val_H2 & val_I2
If groupe = groupe2 Then
'copie des cellules du calcul2
ActiveCell.Range("J1:AM1").Select
Copie_Calcul2 = Selection.Copy
End If
ActiveCell.Offset(1, 0).Select
Loop
End If
Recuperer_Valeur_Calcul2 = Copie_Calcul2
End Function |
Partager