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
|
Option Explicit
Function FExist(NomF As String) As Boolean ' test si la feuille existe
Application.ScreenUpdating = False
On Error Resume Next
FExist = Not Sheets(NomF) Is Nothing
Application.ScreenUpdating = True
End Function
Sub tata1aze0()
Dim i As Integer, j As Integer, k As Integer, m As Integer, Feuille_X As String, Feuille_Y As String, Ligne_vide As Integer
Dim Ligne_du_haut As Integer, Ligne_du_bas As Integer, Nombre_de_lignes As Integer, Nombre_de_colonnes As Byte
Dim Fichier1 As String
Dim Fichier2 As String
Dim Fichier3 As String
Dim Fichier4 As String
Application.ScreenUpdating = False
Fichier1 = InputBox("Indiquez votre 1er Fichier ? Homog?n?iser", "Fichier1")
Fichier2 = InputBox("Indiquez votre 2nd Fichier ? Homog?n?iser", "Fichier2")
Fichier3 = Fichier1 & "post"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = Fichier3
Worksheets(Fichier1).Range("A1:AZ128").Copy
ActiveSheet.Paste Destination:=Worksheets(Fichier3).Range("A1:AZ128")
Fichier4 = Fichier2 & "post"
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = Fichier4
Worksheets(Fichier2).Range("A1:AZ128").Copy
ActiveSheet.Paste Destination:=Worksheets(Fichier4).Range("A1:AZ128")
With ActiveSheet
Range("A2:Z" & Rows.Count).ClearContents
Range("A2:Z" & Rows.Count).Interior.Pattern = xlNone
If FExist(Fichier3) Then
Feuille_X = Fichier1
Feuille_Y = Fichier2
End If
If FExist(Fichier4) Then
Feuille_X = Fichier2
Feuille_Y = Fichier1
End If
Nombre_de_colonnes = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Sheets(Feuille_X).Range("A2:Z" & Sheets(Feuille_X).Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A2")
Ligne_vide = .Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(Feuille_Y).Range("A2:a" & Sheets(Feuille_Y).Range("A" & Rows.Count).End(xlUp).Row).Copy .Range("A" & Ligne_vide)
With .Range(.Cells(Ligne_vide, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, Nombre_de_colonnes)).Interior
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.8
End With
For i = .Range("A" & Rows.Count).End(xlUp).Row To Ligne_vide Step -1
On Error Resume Next
j = Application.WorksheetFunction.Match(.Range("A" & i), .Range("A2:A" & Ligne_vide - 1), 0)
If j > 0 Then .Rows(i).Delete
j = 0
Next i
.Range("A1:Z" & Rows.Count).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
.Range("B2").Activate
Retour:
Do Until ActiveCell.Offset(1, 0) = ""
ActiveCell.Offset(1, 0).Activate
Loop
Ligne_du_haut = ActiveCell.Row
ActiveCell.Offset(1, 0).Activate
Do Until ActiveCell.Offset <> ""
If ActiveCell.Offset(1, -1) = "" Then Exit Sub
ActiveCell.Offset(1, 0).Activate
Loop
Ligne_du_bas = ActiveCell.Row
For k = 2 To Nombre_de_colonnes
For m = Ligne_du_haut + 1 To Ligne_du_bas - 1
Cells(m, k) = Round(Cells(Ligne_du_haut, k) + ((Cells(Ligne_du_bas, k) - Cells(Ligne_du_haut, k)) / (Cells(Ligne_du_bas, 1) - Cells(Ligne_du_haut, 1))) * (Cells(m, 1) - Cells(Ligne_du_haut, 1)), 3)
Next m
Next k
Range("B" & Ligne_du_bas).Activate
GoTo Retour
End With ' ActiveSheet
End Sub |
