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
|
Option Explicit
Sub ConversionIntermédiaire()
Dim XLBook As Workbook
Dim XLSheet As Worksheet
Dim RforRange As Range
Dim t As Variant
Dim i As Variant
Dim l As Variant
Dim FichierOriginal As Worksheet
'Ouverture nouvel XL (sans sauvegarde)
Set XLSheet = ActiveWorkbook.Worksheets("Données_p_conversion")
Set XLBook = Application.Workbooks.Add(xlWBATWorksheet)
'Coller l'onglet des données_p_conversion
Set RforRange = XLBook.Worksheets(1).Range("A1")
XLSheet.UsedRange.Copy RforRange
t = XLSheet.UsedRange.Value
RforRange.Resize(UBound(t, 1), UBound(t, 2)).Value = t
'Sélection de la feuille à convertir (du nouvel XL)
Sheets("Feuil1").Select
With Worksheets("Feuil1")
'Boucle pour convertir en vrai format date
i = 2
While Cells(i, 1) <> "": i = i + 1: Wend
For l = 2 To i - 1
Cells(l, 3) = convertdat(Cells(l, 3))
Cells(l, 6) = convertdat(Cells(l, 6))
Cells(l, 7) = convertdat(Cells(l, 7))
Next
'Ajout d'une colonne
Columns("F:F").Insert Shift:=xlToRight
'Renommer son en-tête de colonne
Cells(1, 6) = "Semaine"
'Boucle pour écrire le numéro de semaine dans la nouvelle colonne
For l = 2 To i - 1
Cells(l, 6) = DatePart("ww", Cells(l, 7), vbMonday, vbFirstFourDays)
Cells(l, 6).NumberFormat = "general"
Next
For l = 2 To i - 1
Cells(l, 4).NumberFormat = "@"
Next
'Suppression des colonnes inutiles
Range(Worksheets("Feuil1").Range("M1"), Worksheets("Feuil1").Range("M1").End(xlDown)).Clear
Range(Worksheets("Feuil1").Range("N1"), Worksheets("Feuil1").Range("N1").End(xlDown)).Clear
Range(Worksheets("Feuil1").Range("O1"), Worksheets("Feuil1").Range("O1").End(xlDown)).Clear
Range(Worksheets("Feuil1").Range("P1"), Worksheets("Feuil1").Range("P1").End(xlDown)).Clear
End With
'Retourner sur l'onglet données_p_conversion original
Set FichierOriginal = Workbooks("Essai COUV SK").Worksheets("Données_p_conversion")
'Suppression du contenu
Sheets("Données_p_conversion").Cells.ClearContents
'A FAIRE // Copier/coller
End Sub
----------
Function convertdat(dat)
convertdat = DateSerial(Left(dat, 4), Mid(dat, 5, 2), Right(dat, 2))
End Function |
