Microsoft 365 passer d'une information en ligne à une information en colonne

fanic

XLDnaute Nouveau
Bonjour,

Je dois automatiser le traitement de prix dégressifs en fonction de la quantité.
Le fabricant nous donne un tarif avec une ligne par référence/Qté/prix alors que mon système informatique traite un article puis qté1/prix1, qté2/prix2... en colonne

Je ne sais pas trop comment faire pour convertir la disposition fournit par le fabricant...
Je mets en pj un exemple pour être plus claire.

Merci d'avance
 

Pièces jointes

  • Classeur1.xlsx
    14.6 KB · Affichages: 8

fanch55

XLDnaute Barbatruc
Salut à tous,
une solution par Macro
VB:
Option Explicit
Sub Transh()
Dim Source As ListObject
Dim Target As ListObject
Dim Target_Name As String
    Set Source = Range("Tableau1").ListObject
    On Error Resume Next
        Target_Name = "Tableau2"
        Range(Target_Name).ListObject.Delete
    On Error GoTo 0

Dim S   As Range
    Set S = Source.ListColumns("Réf").Range.Rows(Source.Range.Rows.Count).Offset(5)
    S.Resize(, 3).Value = Array("Réf", "Qté 1", "Prix 1")
    ActiveSheet.ListObjects.Add(xlSrcRange, S.Resize(1, 3), , xlYes).Name = Target_Name
    Set Target = Range(Target_Name).ListObject

Dim J   As Integer
Dim N   As Integer
Dim Idx As Integer
Dim Réf As Variant
    For J = 1 To Source.DataBodyRange.Rows.Count
        If Source.ListColumns("Réf").DataBodyRange.Rows(J) <> Réf Then
            Réf = Source.ListColumns("Réf").DataBodyRange.Rows(J)
            Idx = Target.ListRows.Add.Index
            Target.ListColumns("Réf").DataBodyRange.Rows(Idx) = Réf
            N = 1
        Else
            N = N + 1
            Set S = Target.HeaderRowRange.Find("Qté " & N, lookat:=xlWhole)
            If S Is Nothing Then
                Set S = Target.HeaderRowRange.Find("Qté " & N - 1, lookat:=xlWhole)
                Target.ListColumns.Add(S.Column + 1).Name = "Qté " & N
                Set S = Target.HeaderRowRange.Find("Prix " & N - 1, lookat:=xlWhole)
                Target.ListColumns.Add(S.Column + 1).Name = "Prix " & N
            End If
        End If
        Target.ListColumns("Qté " & N).DataBodyRange.Rows(Idx) = Source.ListColumns("Qté").DataBodyRange.Rows(J)
        Target.ListColumns("Prix " & N).DataBodyRange.Rows(Idx) = Source.ListColumns("Prix").DataBodyRange.Rows(J)
    Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 655
Messages
2 111 605
Membres
111 217
dernier inscrit
aladinkabeya2