Constitution d'un fichier de cas

Bonjour,

Je souhaite constituer un fichier de cas à partir de plusieurs variables.

1ère variable : habitation pouvant être soit appartement soit maison

2ème variable : nombre de pièces pouvant être 1, 2 ou 3

3ème variable : occupant pouvant être locataire ou propriétaire

Résultat souhaité :

Habitation Nb pièces Occupant

Appartement 1 Locataire

Appartement 1 Propriétaire

Appartement 2 Locataire

Appartement 2 Propriétaire

Appartement 3 Locataire

Appartement 3 Propriétaire

Maison 1 Locataire

Maison 1 Propriétaire

Maison 2 Locataire

Maison 2 Propriétaire

Maison 3 Locataire

Maison 3 Propriétaire

Bien évidemment sans avoir à intercaler des lignes, faire des copier/coller... L'objectif est de combiner 3 variables à plusieurs modalités et ressortir un tableau qui les combine et sort tous les cas possibles.

Voilà.

Je suis un peu perdue là... J'ai vraiment besoin d'aide.

Je vous remercie par avance pour toute l'aide que vous pourrez m'apporter.

Cordialement,

Poup

Bonjour,

et si tu faisais un fichier exemple avec le résultat de ce que tu veux obtenir ?

P.

Bonjour à tous,

Avec 3 boucles imbriquées.

Option Explicit
Sub test()
Dim e, s, v, n As Long, a()
    Application.ScreenUpdating = False
    For Each e In Array("Appartement", "Maison")
        For Each s In Array(1, 2, 3)
            For Each v In Array("Locataire", "Propriétaire")
                n = n + 1
                ReDim Preserve a(1 To 3, 1 To n)
                a(1, n) = e
                a(2, n) = s
                a(3, n) = v
            Next
        Next
    Next
    With Range("a1")
        .Resize(1, UBound(a, 1)) = Array("Habitation", "Nb pièces", "Occupant")
        .Offset(1).Resize(UBound(a, 2), UBound(a, 1)) = Application.Transpose(a)
        With .CurrentRegion
            .Font.Name = "calibri"
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 40
                .Font.Bold = True
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Re Poup82,

On génère 12 combinaisons (2 x 3 x 2), autant figer la dimension de la variable tableau a.

On évite ainsi l'emploi de ReDim Preserve et Application.Transpose

Option Explicit
Sub test()
Dim e, s, v, n As Long, a()
    Application.ScreenUpdating = False
    ReDim a(1 To 12, 1 To 3)   
    For Each e In Array("Appartement", "Maison")
        For Each s In Array(1, 2, 3)
            For Each v In Array("Locataire", "Propriétaire")
                n = n + 1
                a(n, 1) = e
                a(n, 2) = s
                a(n, 3) = v
            Next
        Next
    Next
    With Range("a1")
        .Resize(1, UBound(a, 2)) = Array("Habitation", "Nb pièces", "Occupant")
        .Offset(1).Resize(n, UBound(a, 2)) = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 40
                .Font.Bold = True
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89