XL 2016 VBA : Fonction de remplissage tableau avec condition

[Ethlios]

Bonjour à tous,

Je cherche une fonction VBA pouvant remplir un tableau selon une condition en l'occurrence un nom de produit. (exemple en pièce jointe)

Je pensais partir sur une fonction du type, mais avec la capacité de se mettre dans la bonne colonne selon le nom du produit.

Dim dl As Long
dl = Sheets("Fiche suivi").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Fiche suivi").Range("A" & dl).Value = Range("A4").Value
Sheets("Fiche suivi").Range("B" & dl).Value = Range("B4").Value
Sheets("Fiche suivi").Range("C" & dl).Value = Range("C4").Value

Merci d'avance pour votre aide.

Ethlios.

 

[vgendron]

Bonjour

un exemple avec cette macro

Sub Macro1()
Dim TabData() As Variant
Dim TabRes() As Variant

With Sheets("Feuil1")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A4:C" & fin).Value
End With

With Sheets("Feuil2")
    .UsedRange.Offset(4).ClearContents
    For i = LBound(TabData, 1) To UBound(TabData, 1)
        Select Case TabData(i, 1)
        
            Case "Voiture"
                .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
            
            Case "Bus"
                .Range("H" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("I" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
                
            Case "Vélo"
                .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
            
            Case "Train"
                .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("G" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
            
            Case Else
            
        End Select
    Next i
End With
End Sub

 

[Ethlios]

Bonjour

un exemple avec cette macro

Sub Macro1()
Dim TabData() As Variant
Dim TabRes() As Variant

With Sheets("Feuil1")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    TabData = .Range("A4:C" & fin).Value
End With

With Sheets("Feuil2")
    .UsedRange.Offset(4).ClearContents
    For i = LBound(TabData, 1) To UBound(TabData, 1)
        Select Case TabData(i, 1)
      
            Case "Voiture"
                .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
          
            Case "Bus"
                .Range("H" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("I" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
              
            Case "Vélo"
                .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
          
            Case "Train"
                .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("G" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
          
            Case Else
          
        End Select
    Next i
End With
End Sub

[/QUOTE]

Cela m'a l'air plutôt bien, pouvez-vous m'expliquer son fonctionnement ?

 

[vgendron]

la meme avec des commentaires

Sub Macro1()
'déclaration de deux tablo vba
Dim TabData() As Variant
Dim TabRes() As Variant

With Sheets("Feuil1") 'dans la feuille Feuil1
    fin = .Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne non vide de la colonne A
    TabData = .Range("A4:C" & fin).Value 'on met A4:C11 dans le tablo vba
End With

With Sheets("Feuil2") 'dans la feuille2
    .UsedRange.Offset(4).ClearContents 'on efface tout sauf les entetes
    For i = LBound(TabData, 1) To UBound(TabData, 1) 'pour chaque ligne du tablo de données
        Select Case TabData(i, 1) 'selon le contenu de la colonne 1
       
            Case "Voiture" 'si c'est "Voiture"
                .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2) 'on met la date en fin de colonne   B              
                .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3) 'on met le % en fin de colonne C
           
            Case "Bus"
                .Range("H" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("I" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
               
            Case "Vélo"
                .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
           
            Case "Train"
                .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 2)
                .Range("G" & .Rows.Count).End(xlUp).Offset(1, 0) = TabData(i, 3)
           
            Case Else 'autre cas non prévu==> ici on ne fait rien
           
        End Select
    Next i
End With
End Sub

 

[Ethlios]

Parfait, merci beaucoup !