Gestionnaire_rh
XLDnaute Nouveau
Bonjour tous le monde,
Je pense avoir bien avancé sur mon sujet, reste juste le tri et sous totaux qui ne fonctionne toujours pas
Je pense avoir bien avancé sur mon sujet, reste juste le tri et sous totaux qui ne fonctionne toujours pas
VB:
Sub RemplirBalanceAvecFeuilles()
Dim wsBalanceN As Worksheet
Dim wsBalanceN_1 As Worksheet
Dim wsDest As Worksheet
Dim i As Long
Dim DernLigne As Long
Dim feuilleNom As String
Dim montantN As Double
Dim montantG As Double
Dim difference As Double
Dim lastRow As Long
Dim LastRowDest As Long
Dim compteRecherche As String
Dim cell As Range
Dim dataIndex As Long
Dim rowData(1 To 10) As Variant
Dim destRow As Long
Dim lastRowDict As Object
Set lastRowDict = CreateObject("Scripting.Dictionary")
' Définir les feuilles de travail (Balance N et Balance N-1)
Set wsBalanceN = ThisWorkbook.Sheets("Balance N")
Set wsBalanceN_1 = ThisWorkbook.Sheets("Balance N-1")
' Trouver la dernière ligne non vide de la colonne A dans la feuille Balance N
lastRow = wsBalanceN.Cells(wsBalanceN.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
' Vérifier si la colonne K est positive ou égale à 0, puis récupérer le nom de la feuille
If wsBalanceN.Cells(i, 11).Value >= 0 Or (wsBalanceN.Cells(i, 11).Value < 0 And UBound(Split(wsBalanceN.Cells(i, 12).Value, "/")) = 0) Then
feuilleNom = wsBalanceN.Cells(i, 14).Value
Else
feuilleNom = wsBalanceN.Cells(i, 15).Value
End If
' Définir la feuille de destination
On Error Resume Next
Set wsDest = ThisWorkbook.Sheets(feuilleNom)
On Error GoTo 0
' Vérifier si la feuille de destination existe
If wsDest Is Nothing Then
MsgBox "La feuille " & feuilleNom & " n'existe pas.", vbCritical
GoTo NextIteration
End If
' Ajouter les en-têtes dans la ligne 10 si ce n'est pas déjà fait
If wsDest.Cells(10, 1).Value <> "A10" Then
wsDest.Cells(10, 1).Value = "A10"
wsDest.Cells(10, 2).Value = "Account Name"
wsDest.Cells(10, 3).Value = "Pre-adjusted"
wsDest.Cells(10, 4).Value = "Adjustments"
wsDest.Cells(10, 5).Value = "Adjusted Current Year"
wsDest.Cells(10, 6).Value = "Interim"
wsDest.Cells(10, 7).Value = "Prior Year"
wsDest.Cells(10, 8).Value = "Variance"
wsDest.Cells(10, 9).Value = "In %"
wsDest.Cells(10, 10).Value = "J10"
wsDest.Cells(10, 11).Value = "K10"
wsDest.Cells(10, 12).Value = "Xref"
End If
' Collecter les données pour cette ligne
rowData(1) = wsBalanceN.Cells(i, 1).Value ' Colonne A (Numéro de compte)
rowData(2) = wsBalanceN.Cells(i, 2).Value ' Colonne B (Valeur correspondante)
rowData(3) = CDbl(wsBalanceN.Cells(i, 11).Value) ' Colonne K
rowData(4) = 0 ' Colonne D vide
rowData(5) = CDbl(rowData(3) + rowData(4)) ' Colonne E (C+D)
rowData(6) = "" ' Colonne F vide
rowData(10) = wsBalanceN.Cells(i, 12).Value
' Recherche du montant dans la Balance N-1 basé sur la colonne A (Numéro de compte)
compteRecherche = rowData(1) ' Numéro de compte dans Balance N
Set cell = wsBalanceN_1.Range("A2:A" & wsBalanceN_1.Cells(wsBalanceN_1.Rows.Count, "A").End(xlUp).Row).Find(compteRecherche, LookIn:=xlValues, LookAt:=xlWhole)
' Si trouvé, récupérer la valeur correspondante de la colonne K de la Balance N-1
If Not cell Is Nothing Then
montantG = cell.Offset(0, 10).Value ' Colonne K de Balance N-1 (colonne A + 10 = colonne K)
rowData(7) = CDbl(montantG) ' Colonne G
Else
rowData(7) = "Non trouvé" ' Si non trouvé, afficher "Non trouvé"
End If
' Calculer la différence entre E et G (H = E - G)
montantN = rowData(5)
rowData(8) = CDbl(rowData(5) - rowData(7))
'rowData(8) = difference ' Colonne H
' Utiliser la fonction SI pour gérer l'erreur de division par zéro pour le taux d'erreur (Colonne I)
If rowData(7) <> 0 Then
rowData(9) = rowData(8) / rowData(7)
Else
rowData(9) = "" ' Erreur si G = 0
End If
' Vérifier et récupérer la dernière ligne disponible de la feuille de destination
If Not lastRowDict.exists(feuilleNom) Then
lastRowDict.Add feuilleNom, 11 ' Si c'est la première ligne, commencer à la ligne 11
End If
' Incrémenter la dernière ligne pour cette feuille
DernLigne = lastRowDict(feuilleNom)
' Insérer les données collectées dans la feuille de destination
'wsDest.Rows("11:250").Delete shift:=xlUp
wsDest.Cells(DernLigne, 1).Value = rowData(1)
wsDest.Cells(DernLigne, 2).Value = rowData(2)
wsDest.Cells(DernLigne, 3).Value = CDbl(wsBalanceN.Cells(i, 11).Value)
wsDest.Cells(DernLigne, 4).Value = 0
wsDest.Cells(DernLigne, 5).Value = CDbl(rowData(3) + rowData(4))
wsDest.Cells(DernLigne, 6).Value = 0
wsDest.Cells(DernLigne, 7).Value = rowData(7)
wsDest.Cells(DernLigne, 8) = CDbl(rowData(5) - rowData(7))
wsDest.Cells(DernLigne, 9) = rowData(9)
wsDest.Cells(DernLigne, 12) = rowData(10)
' Mettre à jour la dernière ligne pour cette feuille
lastRowDict(feuilleNom) = DernLigne + 1
NextIteration:
Next i
' Déterminer la dernière ligne dans la colonne A avec des données
destRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
wsDest.Sort.SortFields.Clear
' Appliquer le filtre automatique à la plage incluant l'en-tête
'wsDest.Range("A10:L" & destRow).AutoFilter Field:=12, Criteria1:="<>", Operator:=xlFilterValues
wsDest.Sort.SortFields.Add key:=wsDest.Range("L10:L" & destRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' Effectuer le tri
With wsDest.Sort
.SetRange wsDest.Range("A10:L" & destRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Application des sous-totaux
wsDest.Range("A10:L" & destRow).Subtotal GroupBy:=12, _
Function:=xlSum, _
TotalList:=Array(3, 4, 6, 7), _
Replace:=True, _
PageBreaks:=False
End Sub
