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
|
Sub remplissageFeuilleSuivante(ByVal feuille1 As String, ByVal feuille2 As String, ByVal annee As Integer
Dim nbLignes As Integer
Dim InfoCols As Range 'Tableau de paramétrage des entrées et fonction, feuille "Param"
Dim NRows As Integer
Dim Row As Integer
Dim Col As Integer
Dim FormulaVec() As String, Formulas()
Dim command As Variant, NumberFormat As String, ChangeNumberFormat As Boolean
Dim j As Integer
Dim date_init As Date
Dim date_fin As Date
Dim start, finish, total As Double
start = Timer
Set InfoCols = Range("Info_Cols") 'paramétrage sortie ligne à ligne
NRows = InfoCols.Rows.Count 'Nombre de colonnes en sortie (éventuellement vides)
date_init = DateSerial(annee - 1, 12, 31)
date_fin = DateSerial(annee, 12, 31)
With ThisWorkbook.Sheets(feuille1)
nbLignes = 2
While .Cells(nbLignes, 1) <> ""
nbLignes = nbLignes + 1
Wend
nbLignes = nbLignes - 1
End With
With ThisWorkbook.Sheets(feuille2)
.Cells.ClearContents
.Cells.NumberFormat = "General"
.Cells.Interior.Pattern = xlNone
.Cells.Interior.TintAndShade = 0
.Cells.Interior.PatternTintAndShade = 0
Col = 0
For Row = 1 To NRows
'Passage à la colonne suivante
Col = Col + 1
'Titres et couleurs en-têtes
.Cells(1, Col) = InfoCols(Row, 1)
.Cells(1, Col).Interior.Color = InfoCols(Row, 1).Interior.Color
'Récupération sortie voulue = command
command = InfoCols(Row, 1 + colonne_fonction_info_cols)
If command <> "" Then
command = Replace(command, "date_fin", CDbl(date_fin))
command = Replace(command, "date_deb", CDbl(date_init))
If InfoCols(Row, 2) = 1 Then
command = insertionFeuille(feuille1, command)
End If
'Cas command = nombre
If WorksheetFunction.IsNumber(command) Then
.Range(Cells(2, Col).Address, Cells(nbLignes, Col).Address).Value2 = command
'Cas command = formule
Else
'lecture formule
FormulaVec = readFormula(command, InfoCols)
'vecteur de la taille du portefeuille
ReDim Formulas(1 To nbLignes - 1)
'Formules avec lignes correspondantes
For j = 2 To nbLignes
Formulas(j - 1) = RowFormula(FormulaVec, j)
Next
'Copie formule
.Range(ColNum2Text(Col) & 1 + 1 & ":" _
& ColNum2Text(Col) & nbLignes).Formula = Formulas
End If
End If |
Partager