Etirer une formule sur plusieurs colonnes en VBA
Bonjour,
Je travaille actuellement sur un fichier Excel qui importe un fichier CSV dans un premier temps puis traite les données dans différents tableaux via du code VBA.
Et c'est là que mon problème commence :
J'ai un tableau avec plusieurs colonnes et lignes qui doit se remplir avec une formule écrite en VBA.
' Récupération des consommations moyennes des véhicules
Set PlgRé2 = Feuil1.[A16].Resize(Feuil1.[A65000].End(xlUp).Row - 15, 7)
PlgRé2.Columns(2).FormulaR1C1 = "=IFERROR(((SUMIFS(R2C12:R9C12,R2C3:R9C3,RC1,R2C4:R9C4,R15C)*100)/(SUMIFS(R2C10:R9C10,R2C3:R9C3,RC1,R2C4:R9C4,R15C))),""0,00"")"
Le code ci-dessus me remplit bien la colonne B mais pas les colonnes C et D donc pour le moment j'utilise le code ci-dessous pour étirer ma formule et remplir mes colonnes C et D :
LFinD = Feuil1.[B65000].End(xlUp).Row
Range("B16:B" & LFinD & "").Select
Selection.AutoFill Destination:=Range("B16:D" & LFinD & ""), Type:=xlFillDefault
Le problème est que le tableau ci-dessus est un import d'un fichier CSV et donc le nombre de lignes et de colonnes à calculer dans mon 2ème tableau peut varier. C'est donc là que le code ci-dessous a des limites car je m'arrête à la colonne D.
Ma question est donc de savoir comment je peux passer en variable le nombre de colonnes où il faut que ma formule se calcule?
Je vous mets en pièce jointe un exemple pour que ce soit plus clair.
Merci de votre aide car là je bloque malgré mes recherches faites sur le net et mes différentes tentatives...
Grhum29
Bonsoir,
Copie cette procédure dans un module standard.
Elle crée un tableau dynamique, puis un tableau croisé dynamique (TCD) avec un champ calculé pour la consommation moyenne.
A te relire, pour un complément d'informations.
Cdlt.
Option Explicit
Public Sub Consommation_moyenne()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim ptCache As pivotCache
Dim pt As PivotTable
Dim modeCalc As XlCalculation
With Application
modeCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Feuil1")
On Error Resume Next
wb.Worksheets("TCD").Delete
On Error GoTo 0
Application.DisplayAlerts = True
With ws
Set lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
With lo
.Name = "Tableau1"
.TableStyle = ""
End With
End With
wb.Worksheets.Add After:=wb.Worksheets(Worksheets.Count)
ActiveSheet.Name = "TCD"
Set ptCache = wb.PivotCaches.Create(xlDatabase, lo.Range, 3)
Set pt = ptCache.CreatePivotTable(Cells(1), "TCD1", , 3)
With pt
.ManualUpdate = True
.AddFields RowFields:="Site géographique", ColumnFields:="Modéle véhicule"
.CalculatedFields.Add "Conso moyenne", _
"='Nb, litres consommés' /'Nb, kilomètres parcourus' *100", True
With .PivotFields("Conso moyenne")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0.00"
.Caption = ChrW(931) & " Conso moyenne"
End With
.RowAxisLayout xlTabularRow
.TableStyle2 = ""
.DisplayErrorString = True
.ManualUpdate = False
End With
Application.Calculation = modeCalc
Set pt = Nothing
Set ptCache = Nothing
Set lo = Nothing
Set ws = Nothing
Set wb = Nothing
End Sub