1 pièce(s) jointe(s)
Macro avec utilisation de tableau vba
Bonjour à tous,
Cela faisait longtemps que je n'avais pas touché aux macros excel et aux tableaux en particulier.
J'ai un fichier qui se présente comme ceci : Pièce jointe 637287
Dans les cellules sous les dates je souhaite distribuer le budget journalier pour chaque tâche sous les dates correspondantes.
J'ai un tableau, pour la partie à renseigner, de 491 lignes et 3344 colonnes ( de decembre 2021 à janvier 2031) soit plus de 1,6 millions de cellules. Etant donné le nombre de cellules à traiter j'ai imméditement pensé à utiliser un tableau.
J'ai consulté mes archives et mes anciens messages pour retrouver un peu de référence et voici ce à quoi je suis arrivé
Code:
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
| Sub Assign_Budget()
Dim Data_1 As Worksheet
Dim Input_Data As Range
Dim Data_Month As Range
Dim Tableau_TCC2() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Set Data_1 = ThisWorkbook.Sheets("Data_1")
Set Input_Data = Data_1.Range("D4")
Set Data_Month = Data_1.Range("L3")
Dim NbCol1 As Integer
Dim NbCol2 As Integer
Dim NbLig As Integer
With Data_1
NbLig = .Cells(.Rows.Count, 1).End(xlUp).Row
NbCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column - 11
End With
x = NbLig
y = NbCol1
ReDim Tableau_TCC2(1 To x, 1 To y)
For i = 1 To x
For j = 1 To y
If Data_Month.Offset(0, j - 1) >= Input_Data.Offset(i - 1, 0) And Data_Month.Offset(0, j - 1) < Input_Data.Offset(i - 1, 1) And Data_Month.Offset(-1, j - 1) <> "1" Then
Tableau_TCC2(i, j) = Input_Data.Offset(i - 1, 6)
Else
Tableau_TCC2(i, j) = "0"
End If
Next j
Next i
For i = 1 To x
For j = 1 To y
Data_Month.Offset(i, j - 1) = Tableau_TCC2(i, j)
Next j
Next i
End Sub |
J'ai dû oublier quelquechose car la macro prend un temps fou pour s'executer :roll:
Je fais donc appel à vos connaissances pour m'aiguiller sur le bon chemin ;)
Eric
