oguruma
XLDnaute Occasionnel
Suite de ce post
excel-downloads.com
Comment y parvenir via une macro en VBA ?
voir le fichier joint
Transposer en colonnes des blocs de données en lignes - via formules - LET & LAMBDA
Suite du sujet comme annoncé dans le post initial ici https://excel-downloads.com/threads/transposer-en-colonnes-des-blocs-de-donnees-en-lignes-via-formules.20080376/ transformation de la formule DECALER avec tous ses composants en une fonction LAMBDA en passant par LET. L'exemple retenu simule...
Comment y parvenir via une macro en VBA ?
VB:
Option Explicit
Sub DEGROUPER_LIGNES_COLONNES()
Dim DataSource As Range
Dim lngIndexRow As Long
Dim lngIndexColumn As Long
Dim LngIndexStartRow As Long
Dim LngIndexStartColumn As Long
Dim lngParse As Long
Dim lngMaxLoopRow As Long
Dim lngMaxLoopCol As Long
Dim iNbItem As Integer
Dim WkCible As Worksheet
' Source des données à dégrouper
Set DataSource = Range("COL_RUBRIQUES")
' Nombre d'item par bloc
iNbItem = Range("NB_RUBRIQUES_GROUPE")
' Index de départ ligne et colonne
LngIndexStartRow = Range("LIGNE_DEBUT_DONNEES").Value
LngIndexStartColumn = Range("COLONNE_DEBUT_DONNEES").Value
lngIndexRow = LngIndexStartRow
lngIndexColumn = LngIndexStartColumn
' On se positionne sur l'onglet cible
Set WkCible = Worksheets(Range("ONGLET_CIBLE").Value)
WkCible.Activate
' Réinitialise la feuille
Cells.ClearContents
' On positionne les titres des colonnes par formule - bcp plus simple
Cells(LngIndexStartRow - 1, LngIndexStartColumn).Formula2R1C1 = _
"=TRANSPOSE(INDIRECT(ADRESSE_RUBRIQUE & "":"" & ADRESSE_RUBRIQUE_FIN))"
' Init du parsing des données
lngParse = 0
lngMaxLoopRow = (LngIndexStartRow + (DataSource.Rows.Count / iNbItem))
' Parsing des données ligne/colonne
For lngIndexRow = LngIndexStartRow To lngMaxLoopRow
' On détermine les limites du parsing
lngMaxLoopCol = LngIndexStartColumn + iNbItem - 1
' dispatching en colonne
For lngIndexColumn = LngIndexStartColumn To lngMaxLoopCol
' on se déplace dans le tableau
lngParse = lngParse + 1
' On va se décaler d'une cellule pour récupérer la valeur de l'item et affectation
WkCible.Cells(lngIndexRow, lngIndexColumn).Value = DataSource.Cells(lngParse, 1).Offset(0, 1)
Next lngIndexColumn
' et traitement du bloc suivant
Next lngIndexRow
MsgBox "Dégroupage des données effectué"
End Sub
voir le fichier joint