Problème de remplissage de tableau VBA

Bonsoir,

J’ai commencé à travailler tout récemment sur VBA et actuellement je me retrouve bloquée sur un exercice.

Il s’agit d’un problème par rapport au remplissage de tableaux (voir fichier en pièce jointe)

Onglet Résultat : dans la première colonne les valeurs (que je récupère par rapport à l’élément de référence : ici Company) sont dupliquées et du coup les autres colonnes du tableau se remplissent avec un décalage

Est-ce que vous pourriez m’expliquer ce qu’il faudrait faire pour que la jointure fonctionne ?

Merci d’avance pour votre aide !

Voici la partie du code où je n'arrive pas trouver l'erreur

'Récupération des valeurs pour T-1

For i = 1 To nbL2

If feuille2.Cells(i, 1) = collection Then

feuille1.Cells(i1, 1) = feuille2.Cells(i, 2) 'remplissage avec données Department en T-1

feuille1.Cells(i1, 2) = feuille2.Cells(i, 3) 'Staff en T-1

feuille1.Cells(i1, 4) = feuille2.Cells(i, 4) 'Rev en T-1

End If

Next i

'Récupération des valeurs pour T

For i = 1 To nbL3

If feuille3.Cells(i, 1) = collection Then

feuille1.Cells(i1, 1) = feuille3.Cells(i, 2) 'Department T

feuille1.Cells(i1, 3) = feuille3.Cells(i, 3) 'Staff en T

feuille1.Cells(i1, 5) = feuille3.Cells(i, 4) 'Rev en T

End If

Bonsoir et bienvenue,

ton fichier manque (sans doute trop gros)

je vois une erreur dans l'utilisation de i1 qui fait que ta boucle i ne sert à rien. (tu vas retrouver dans ta cellule(I1,1) la valeur de cellule(nbl2,2) et A quoi correspond ce i1 ? je soupconne qu'il manque un i1=i1+1 comme première instruction après le if ... then

Bonjour,

effectivement j'ai oublié d'insérer le fichier...le voici...j'ai mis la version simplifiée du tableau.

i1 avait été défini comme première ligne de chaque tableau tableau

FistL = i1 i1 = 4

feuille1.Cells(i1 - 1, 1) = "Department"

feuille1.Cells(i1 - 1, 2) = "Staff Q-1"

feuille1.Cells(i1 - 1, 3) = "Staff Q"

merci

Bonjour,

une proposition de code sur base de ton fichier.

Dim wss As Object, wst As Object, re As Object
Dim i1 As Long
Dim i As Long, j As Long, company As String

Sub fusion()
' wst = identifiant de la feuille Résultat
    Set wst = Worksheets("Résultat")
    'wss = identifiant de la feuille source des données
    Set wss = Worksheets("Trimestre Q-1")
    ' on vide le contenu de la feuille résultat
    wst.Cells.Delete
    ' dlwss contient le numéro de la dernière ligne utilisée dans la feuille source
    dlwss = wss.Range("A" & Rows.Count).End(xlUp).Row
    ' i1 numéro de ligne sur résultat
    i1 = 0
    ' company contient la company en cours
    company = ""
    ' on prend toutes les lignes de la feuille source
    For i = 2 To dlwss
        If company <> wss.Cells(i, 1) Then
        ' si nouvelle company on mt un entête
            entête
            'on mémorise la nouvelle company en cours
            company = wss.Cells(i, 1)
        End If
        ' on écrit le détail
        detail1
    Next i
    ' on prend la 2ème feuille source
    Set wss = Worksheets("Trimestre Q")
    '
    dlwss = wss.Range("A" & Rows.Count).End(xlUp).Row

    ' on prend toutes les lignes de la feuille source
    For i = 2 To dlwss
    ' on recherche si la company trouvée sur la feuille 2 existe déjà dans la feuille résultat
        Set re = wst.Range("A1:A" & i1).Find("Company " & wss.Cells(i, 1), lookat:=xlWhole)
        ' on l'a trouvée
        If Not re Is Nothing Then
            j = re.Row + 1
            ' on cherche le département
            Do While wst.Cells(j, 1) <> ""
                If wst.Cells(j, 1) = wss.Cells(i, 2) Then
                ' on l'a trouvé on met le détail sur le même ligne
                    detail2
                    Exit Do
                End If
                j = j + 1
            Loop
            If wst.Cells(j, 1) = "" Then
            'on n'a pas trouvé le département, on ajoute une nouvelle ligne
                wst.Rows(j).Insert shift:=xlDown
                i1 = i1 + 1
                detail2
            End If
        Else
        ' on n'a pas trouvé la company, on ajoute un entête, puis on met le détail
            entête
            i1 = i1 + 1
            j = i1
            detail2
        End If
    Next i
End Sub

Sub entête()
    i1 = i1 + 2
    wst.Cells(i1, 1) = "Company " & wss.Cells(i, 1)
    wst.Cells(i1, 1).Font.ColorIndex = 4
    wst.Cells(i1, 1).Font.Bold = True
    i1 = i1 + 1
    wst.Cells(i1, 1) = "Departement"
    wst.Cells(i1, 2) = "Staff Q-1"
    wst.Cells(i1, 3) = "Staff Q"
    wst.Cells(i1, 4) = "Rev Q-1"
    wst.Cells(i1, 5) = "Rev Q"
    wst.Range(Cells(i1, 1), Cells(i1, 5)).Borders.Weight = xlThin
    wst.Range(Cells(i1, 1), Cells(i1, 5)).Font.Bold = True
End Sub
Sub detail1()
    i1 = i1 + 1
    wst.Cells(i1, 1) = wss.Cells(i, 2)
    wst.Cells(i1, 2) = wss.Cells(i, 3)
    wst.Cells(i1, 4) = wss.Cells(i, 4)
    wst.Range(Cells(i1, 1), Cells(i1, 5)).Borders.Weight = xlThin
End Sub

Sub detail2()
    wst.Cells(j, 1) = wss.Cells(i, 2)
    wst.Cells(j, 3) = wss.Cells(i, 3)
    wst.Cells(j, 5) = wss.Cells(i, 4)
    wst.Range(Cells(j, 1), Cells(j, 5)).Borders.Weight = xlThin
End Sub