Bouclage avec un ensemble de données infini

Je pense donc que cela vous permettra de choisir dynamiquement la taille de votre ensemble de données. Je suppose que les en-têtes de colonne seront toujours à la ligne 5, comme illustré. Il parcourt chaque colonne d'entrée et fournit une sortie unique en H, I et J. Avis de non-responsabilité: Je n'ai pas pu tester cela car je ne suis pas sur mon PC de travail.

Sub MixTheStuff()

'sets size of data in A (Set).  -5 for the header row as noted
x = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row - 5  
 
'sets size of data in B (#)
y = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 2).End(xlUp).Row - 5

'sets size of data in E (Animal)
z = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 5).End(xlUp).Row - 5   

i=6 'First row after the headers

For sThing = 1 to x    'set thing
For nThing = 1 to y    'number thing
For aThing = 1 to z    'animal thing

    'Pastes the value of the stuff (Set, #, and Animal respectively)
    ThisWorkbook.Sheets("Data").cell(i,10) = ThisWorkbook.Sheets("Data").cell(x,1).value
    ThisWorkbook.Sheets("Data").cell(i,11) = ThisWorkbook.Sheets("Data").cell(y,2).value
    ThisWorkbook.Sheets("Data").cell(i,12) = ThisWorkbook.Sheets("Data").cell(z,5).value

i = i + 1 'Go to the next output row

Next sThing
Next nThing
Next aThing

End Sub

Sorte de non pivot

• Cela vous permettra de gérer au maximum 1023 animaux.

Le code

Option Explicit

Sub SortOfUnpivot()
    
    Const FirstRow As Long = 6
    Const LastRowCol As String = "E"
    Const dstFirstCell As String = "H6"
    Dim srcCols As Variant
    srcCols = VBA.Array("A", "B", "E")
    
    Dim LB As Long
    LB = LBound(srcCols)
    Dim UB As Long
    UB = UBound(srcCols)
    Dim srcCount As Long
    srcCount = UB - LB + 1
    
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, LastRowCol).End(xlUp).Row
    Dim rng As Range
    Set rng = Cells(FirstRow, LastRowCol).Resize(LastRow - FirstRow + 1)
    Dim Source As Variant
    ReDim Source(LB To UB)
    
    Dim j As Long
    For j = LB To UB
        Source(j) = rng.Offset(, Columns(srcCols(j)).Column - rng.Column).Value
    Next j
    
    Dim UBS As Long
    UBS = UBound(Source(UB))
    
    Dim Dest As Variant
    ReDim Dest(1 To UBS ^ 2, 1 To srcCount)
    Dim i As Long
    Dim k As Long
    
    For j = 1 To UBS
        k = k + 1
        For i = 1 + (j - 1) * UBS To UBS + (j - 1) * UBS
            Dest(i, 1) = Source(0)(k, 1)
            Dest(i, 2) = Source(1)(k, 1)
            Dest(i, 3) = Source(2)(i - (j - 1) * UBS, 1)
        Next i
    Next j
    
    Range(dstFirstCell).Resize(UBound(Dest), srcCount).Value = Dest
    
    
End Sub

Je pense que vous trouveriez cela plus facile si vous considérez VBA comme plus un langage de programmation qu'un enregistreur de macros. Dans votre exemple, la tâche consiste simplement à créer un tableau dont le nombre de lignes est:

nombre de noms de set * nombre d'éléments de set

Tout ce que vous avez à faire est de remplir ce tableau en suivant un certain modèle. Dans votre exemple, ce serait:

définir le numéro n avec tous les éléments définis, définir le numéro n + 1 avec tous les éléments définis, etc.

Le code squelette ressemblerait à ceci:

Const SET_NAMES_ROW_START As Long = 6
Const SET_ITEMS_ROW_START As Long = 6
Const SET_NAMES_COL As String = "A"
Const SET_ITEMS_COL As String = "E"
Const OUTPUT_ROW_START As Long = 6
Const OUTPUT_COL As String = "G"

Dim names() As Variant, items() As Variant, output() As Variant
Dim namesCount As Long, itemsCount As Long
Dim idx As Long, nameIdx As Long, itemIdx As Long

'Read the set values.
With Sheet1
    names = .Range( _
                .Cells(SET_NAMES_ROW_START, SET_NAMES_COL), _
                .Cells(.Rows.Count, SET_NAMES_COL).End(xlUp)) _
               .Resize(, 2).Value2
    items = .Range( _
                .Cells(SET_ITEMS_ROW_START, SET_ITEMS_COL), _
                .Cells(.Rows.Count, SET_ITEMS_COL).End(xlUp)) _
               .Value2
End With

'Dimension the output array.
namesCount = UBound(names, 1)
itemsCount = UBound(items, 1)

ReDim output(1 To namesCount * itemsCount, 1 To 3)

'Populate the output array.
nameIdx = 1
itemIdx = 1
For idx = 1 To namesCount * itemsCount
    output(idx, 1) = names(nameIdx, 1)
    output(idx, 2) = names(nameIdx, 2)
    output(idx, 3) = items(itemIdx, 1)
    itemIdx = itemIdx + 1
    If itemIdx > itemsCount Then
        'Increment the name index by 1.
        nameIdx = nameIdx + 1
        'Reset the item index to 1.
        itemIdx = 1
    End If
Next

'Write array to the output sheet.
Sheet1.Cells(OUTPUT_ROW_START, OUTPUT_COL).Resize(UBound(output, 1), UBound(output, 2)).Value = output