VBA? valeurs d'une ligne reportées s/ plusieurs lignes s/ une autre feuille

Le 10/07/2021 à 02:24

Salut tout le monde !

J'ai dans une feuille (Global), en colonne B, des codes barre (un différent par ligne), avec sur leur ligne respective, les résultats qui leur correspondent.

Je cherche, dans une autre feuille (EXPORT HXL) en colonne A, mettre 5x le Code barre n°1 (donc lignes 1 a 5), avec les résultats qui lui correspondent dans les cellules d'à côté (les résultats sont en Global! F à J), et je voudrais qu'en suivant de ces 5 lignes viennent le code barre n°2 (donc lignes 6 a 10), avec les résultats qui lui correspondent.

j'ai tenté de copier 5x la formule =Global!B3 de A1 a A5, puis 5x la formule =Global!B4 de A6 a A10, mais quand j'étire mes formules, je passe directement a =Global!B13, au lieu de B5...

J'ai en tête un VBA qui ferait une boucle :

Pour chaque cellule non vide de Global!B, copier 5x le code barre et
- ligne 1 mettre le résultat 1
- ligne 2 mettre le résultat 2
-etc.

Seul problème, mes compétences en VBA s'arrêtent au "enregistrer une macro" d'excel ^^'

Du coup, si une âme charitable aurait le temps de me proposer un code (que je pourrai adapter, si tout va bien, avec mes cases et résultats, j'arrive a peu près a lire du VBA), je lui serai éternellement reconnaissant !

Merci d'avance ! Je n'aime pas trop demander ça comme ça, c'est un peu du travail gratuit de votre part, mais je suis complètement bloqué là dessus !

24template-global-forum.xlsm (68.03 Ko)
Le 10/07/2021 à 10:00

Bonjour,

Une proposition Power Query.

Pour Excel 2013, il est nécessaire d'installer le complément gratuit de Microsoft.

La solution est simple à mettre en oeuvre et ne demande pas de connaissances particulières.

Cdlt.

14template-global-forum.xlsm (78.60 Ko)
Le 10/07/2021 à 10:31

Bonjour cossinelle, Jean-Eric , le forum,

Un essai par macro.........mais compliqué si tu n'as aucunes bases en VBA...

Sub test()
  Dim tablo, tabloN(), k%, i%, j%

   Sheets("EXPORT HXL").Range("A1").Cells.Delete

   With Sheets("Global")
     j = 6
      Do While j <= 10
       k = 0
       tablo = .Range("A1").CurrentRegion
       For i = 3 To UBound(tablo, 1)
         ReDim Preserve tabloN(1 To 4, 1 To k + 1)
          tabloN(1, 1 + k) = tablo(i, 1)
          tabloN(2, 1 + k) = tablo(i, 2)
          tabloN(3, 1 + k) = IIf(tablo(i, 1) <> "", .Cells(1, j), "")
          tabloN(4, 1 + k) = tablo(i, j)
        k = 1 + k
       Next i
     On Error Resume Next
       Sheets("EXPORT HXL").Range("A" & Sheets("EXPORT HXL").Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(tabloN, 2), 4) = Application.Transpose(tabloN)
        Erase tabloN
     j = j + 1
      Loop
  End With
       Sheets("EXPORT HXL").Activate
       Sheets("EXPORT HXL").Columns("A:D").Sort Key1:=Range("A1")
End Sub

CTRL + e pour exécuter la macro...

10cossinelle-template-global-forum.xlsm (74.20 Ko)

Cordialement,

Le 10/07/2021 à 10:37

Bonjour,

Autre solution VBA, peut-être plus simple à comprendre

Sub Recup_Valeurs()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long
    Dim i As Long, Lig As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Global")
    Set f2 = Sheets("EXPORT HXL")
    f2.Columns("A:C").Clear
    DerLig_f1 = f1.Range("B" & Rows.Count).End(xlUp).Row
    f2.Range("A1:A" & DerLig_f1 - 2).Value = f1.Range("B3:B" & DerLig_f1).Value
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    For i = DerLig_f2 To 1 Step -1
        f2.Range("A" & i).Copy
        f2.Range("A" & i + 1 & ":A" & i + 4).Insert Shift:=xlDown
    Next i
    DerLig_f2 = DerLig_f2 * 5
    For i = 1 To DerLig_f2 - 4 Step 5
        f2.Range("B" & i & ":B" & i + 4).Value = Application.Transpose(Array("TECH", "INDI", "ORIG", "NXCLA", "LINEA"))
    Next i

    Lig = 1
    For i = 3 To DerLig_f1
        Range("C" & Lig).FormulaR1C1 = "=IF(R" & i & "C1<>"""",Global!R" & i & "C6,"""")"
        Range("C" & Lig + 1).FormulaR1C1 = "=IF(R" & i + 1 & "C1<>"""",Global!R" & i & "C7,"""")"
        Range("C" & Lig + 2).FormulaR1C1 = "=IF(R" & i + 2 & "C1<>"""",Global!R" & i & "C8,"""")"
        Range("C" & Lig + 3).FormulaR1C1 = "=IF(R" & i + 3 & "C1<>"""",Global!R" & i & "C9,"""")"
        Range("C" & Lig + 4).FormulaR1C1 = "=IF(R" & i + 4 & "C1<>"""",Global!R" & i & "C10,"""")"
        Lig = Lig + 5
    Next i

    Set f1 = Nothing
    Set f2 = Nothing
End Sub
Le 10/07/2021 à 13:38

Bonjour

Bonjour à tous

Une variante.

5template-global-forum-v1.xlsm (74.49 Ko)
Dim fg As Worksheet, tablo, tabloR(), dico As Object, clé, it
Dim i&, j&, k&, t&

Private Sub Worksheet_Activate()

    Set fg = Sheets("Global")
    tablo = fg.Range("A1").CurrentRegion
    Set dico = CreateObject("Scripting.Dictionary")

    For i = 2 To UBound(tablo, 1)
        If tablo(i, 2) <> "" Then
            dico(tablo(i, 2)) = i
        End If
    Next
    clé = dico.Keys
    it = dico.items

    ReDim tabloR(1 To dico.Count * 5, 1 To 3)
    k = 0
    For i = 0 To dico.Count - 1
        For t = 0 To 4
            tabloR(k + 1 + t, 1) = clé(i)
            tabloR(k + 1 + t, 2) = tablo(1, 6 + t)
            tabloR(k + 1 + t, 3) = tablo(it(i), 6 + t)
        Next t
        k = k + 5
    Next i
    Sheets("EXPORT HXL").Cells.ClearContents
    Sheets("EXPORT HXL").Range("A1").Resize(UBound(tabloR, 1), 3) = tabloR

End Sub

Bye !

Le 10/07/2021 à 14:50

Merci a tous les 4 !!

Je regarde ça en détails cette nuit (je bosse de nuit ^^) et je reviens vers vous !

Merci énormément !

Le 10/07/2021 à 15:45

Salut tout le monde, finalement j'ai commencé a gratter cet aprem ^^

Je pense effectivement que je vais partir sur le code de @Arturo83, plus simple pour mon cerveau débutant en vba, même si je comprend vaguement le principe derrière les 2 autre codes !

J'ai "compris" tout jusqu'à la partie intéressante ou on colle les valeurs résultats de chaque analyse.

Je vois la boucle, qui écrit 5 lignes pour i qui va de 3 au nombre de lignes du tableau f1, mais je ne comprend pas la formule assignée a chaque cellule de la colonne C :

"=IF(R" & i & "C1<>"""",Global!R" & i & "C6,"""")"

Du coup, si je veux changer mes colonnes ou sont mes résultats dans Global!, je ne vois pas comment faire ^^'

Une âme charitable pour m'aider ?

    Lig = 1
    For i = 3 To DerLig_f1
        Range("C" & Lig).FormulaR1C1 = "=IF(R" & i & "C1<>"""",Global!R" & i & "C6,"""")"
        Range("C" & Lig + 1).FormulaR1C1 = "=IF(R" & i + 1 & "C1<>"""",Global!R" & i & "C7,"""")"
        Range("C" & Lig + 2).FormulaR1C1 = "=IF(R" & i + 2 & "C1<>"""",Global!R" & i & "C8,"""")"
        Range("C" & Lig + 3).FormulaR1C1 = "=IF(R" & i + 3 & "C1<>"""",Global!R" & i & "C9,"""")"
        Range("C" & Lig + 4).FormulaR1C1 = "=IF(R" & i + 4 & "C1<>"""",Global!R" & i & "C10,"""")"
        Lig = Lig + 5
    Next i
Le 10/07/2021 à 17:17

Du coup, si je veux changer mes colonnes ou sont mes résultats dans Global!, je ne vois pas comment faire ^^'

Range("C" & Lig).FormulaR1C1 = "=IF(R" & i & "C1<>"""",Global!R" & i & "C6,"""")"

C6 = colonne 6 qui correspond à la colonne F de la feuille Global,

C7 = colonne 7 qui correspond à la colonne G de la feuille Global, et ainsi de suite pour les autres lignes, est-ce bien cela dont vous voulez parler ? si vous choisissez d'autres emplacements, il suffit de donner la position en chiffre plutôt que la lettre.


Le 10/07/2021 à 18:21

Merci ENORMEMENT !

J'avais pas du tout compris que c'était le numéro de la colonne, je croyais qu'il y avait une transposition qui se cachait quelque part =D

Le 10/07/2021 à 19:00

Hello à tous

Je ne vois pas pourquoi je ne pourrai pas participer à la fête sous prétexte qu'il y a déjà eu plusieurs réponses

Voici ma proposition 

Type Tind
    strNAME As String
    strTECH As String
    strINDI As String
    strORIG As String
    strNXCLA As String
    strLINEA As String
End Type

Sub remplissage()

Const strname_global As String = "Global"
Const strname_export As String = "EXPORT HXL"

Dim indicateur() As Tind
Dim i As Long, lnglast_row As Long, j As Long, y As Long
Dim wksglobal As Worksheet, wksexport As Worksheet
Dim vararray_indi, varvalues, varcol
Dim bytfirst_row As Byte

Set wksglobal = Sheets(strname_global)
Set wksexport = Sheets(strname_export)
bytfirst_row = 3

With wksglobal
    lnglast_row = .Cells(Rows.Count, 2).End(xlUp).Row
    ReDim indicateur(lnglast_row - bytfirst_row)
    varcol = Array(2, 6, 7, 8, 9, 10)
    For i = bytfirst_row To lnglast_row
        indicateur(i - bytfirst_row).strNAME = .Cells(i, varcol(0))
        indicateur(i - bytfirst_row).strTECH = .Cells(i, varcol(1))
        indicateur(i - bytfirst_row).strINDI = .Cells(i, varcol(2))
        indicateur(i - bytfirst_row).strORIG = .Cells(i, varcol(3))
        indicateur(i - bytfirst_row).strNXCLA = .Cells(i, varcol(4))
        indicateur(i - bytfirst_row).strLINEA = .Cells(i, varcol(5))
    Next i
End With

Application.ScreenUpdating = False
Application.Calculation = xlManual
With wksexport
    .Cells.ClearContents
    vararray_indi = Array("TECH", "INDI", "ORIG", "NXCLA", "LINEA")
    For i = LBound(indicateur) To UBound(indicateur)
        lnglast_row = .Cells(Rows.Count, 1).End(xlUp).Row
        If lnglast_row = 1 Then y = 1 Else y = lnglast_row + 1
        For j = 1 To 5
            .Cells(y, 1) = indicateur(i).strNAME
            .Cells(y, 2) = vararray_indi(j - 1)
             y = y + 1
        Next j
        lnglast_row = .Cells(Rows.Count, 3).End(xlUp).Row
        If lnglast_row = 1 Then y = 1 Else y = lnglast_row + 1
        .Cells(y, 3) = indicateur(i).strTECH
        .Cells(y + 1, 3) = indicateur(i).strINDI
        .Cells(y + 2, 3) = indicateur(i).strORIG
        .Cells(y + 3, 3) = indicateur(i).strNXCLA
        .Cells(y + 4, 3) = indicateur(i).strLINEA
    Next i
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

Set wksglobal = Nothing
Set wksexport = Nothing

MsgBox "Fini"
End Sub
Le 10/07/2021 à 19:51

@ Rag

Tu as tout à fait raison.

Et pour ma part je trouve toujours intéressant de voir comment d'autres s'y sont pris pour traiter un problème sur lequel je me suis penché.

J'y trouve souvent des idées ou des choses intéressantes...

Bye !

Rechercher des sujets similaires à "vba valeurs ligne reportees lignes feuille"