Machen Sie horizontale Liste vertikal in Excel

Question

Ich habe die Notwendigkeit, einen Teil einer horizontalen Liste vertikal zu drehen. Ich habe versucht, TRANSPOSE ohne Erfolg zu verwenden.

Mit einem VBA-Skript habe ich leere Zeilen unterhalb der vier oder fünfstelligen Produktnummer eingefügt. Und ich möchte die im Bild gezeigten Werte verschieben (oder kopieren/einfügen).

Excel-Liste

I modifiziert, um ein Skript VBA mir gegeben (Kredit TheAtomicOption gegeben), aber Excel Ständen wenn ich laufe es:

Sub Sizes() 

'figure out how far down data goes 
Range("A1").Select 
Selection.End(xlDown).Select 
Dim endrow 
endrow = Selection.Row 

'always start in the correct column 
Range("D1").Select 
Selection.End(xlDown).Select 
ActiveCell.Offset(0, -1).Activate 

Dim rownumber 

'loop through all data 
Do While ActiveCell.Row < endrow 
    'Store cell of current base name 
    rownumber = ActiveCell.Row 


    'loop through empty cells and set formula if cell isn't empty 
    Do While True 
     ActiveCell.Offset(1, 0).Activate 

     'if next cell isn't empty, isn't past the end of the list, go to outer loop 
     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=E(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=F(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=G(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=H(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=I(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     Else 
      Exit Do 
     End If 
     End If 
     End If 
     End If 
     End If 

    Loop 
Loop 

End Sub 

Irgendwelche Vorschläge, wie man zu lösen, und wie das Skript zu verbessern?

EDIT: Spalte A ist nur eine Stütze Spalte für Selection.End(xlDown).Select Spalte B ist ein Zähler für die Größen. Es ist für das anfängliche Skript, das neue Zeilen eingefügt hat. Spalte C ist Artikelnummer/Produkt ID Spalte D ist die Spalte, in der alle Größen aufgeführt werden sollen. Spalte E-I und in der Reihe mit SKU ist, wo die Größen jetzt aufgeführt sind.

Wie das Endergebnis

Edit 2 aussehen sollte: von QHarr

Lösung, dank Skript.

Option Explicit 

Sub Sizes() 
Dim wb As Workbook 
Dim ws As Worksheet 

'figure out how far down data goes 
Dim endrow As Long 
Dim rownumber As Long 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("Sheet1") ' Modified the sheet name 

With ws 
    endrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    'always start in the correct column 
    .Cells(.Cells(1, "D").End(xlDown).Row, "D").Offset(, -1).Activate 

    'loop through all data 
    Do While ActiveCell.Row < endrow 

     'loop through empty cells and set formula if cell isn't empty 
     Do While ActiveCell.Row <= endrow 

     'Set rownumer at new product id 

     rownumber = ActiveCell.Row 

      ActiveCell.Offset(1, 0).Activate 

      'if next cell isn't empty, isn't past the end of the list, go to outer loop 
      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=E" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=F" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=G" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=H" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=I" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      Else 
       Exit Do 
      End If 
      End If 
      End If 
      End If 
      End If 
     Loop 
    Loop 

End With 

End Sub 

Answer 1

Ich habe diesen Code nicht optimiert, aber sehen, ob das funktioniert. Ich habe Verweise auf Arbeitsmappe und Zielarbeitsblatt hinzugefügt. Sie müssen den Namen des Zielarbeitsblatts ändern.

Hinzugefügte Variablen, die mit Datentyp deklariert sind.

Single Do Schleife mit Ausgangsbedingung, die erfüllt werden kann.

Korrigierte Syntax und für jede der Leitungen mit dem folgenden Format Offset entfernt haben: ActiveCell.Offset (0, 1) .Formula = "= E (" & RowNumber & ")"

Sie benötigt Active. Formel = "= E" & Zeilennummer

Hinweis: Ich gehe davon aus, dass Sie eine Spalte loopen, so dass nur eine Schleife benötigt wird. Ursprünglicher Code mit 2 Loops, die Sie benötigen würden Do While ActiveCell.Row < für beide Schleifen und ActiveCell.Formula = "= E" & Zeilennummer + 1 usw.

Option Explicit 

Sub Sizes() 
Dim wb As Workbook 
Dim ws As Worksheet 
Dim endrow As Long 
Dim rownumber As Long 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("TargetSheetName") 

With ws 

    'figure out how far down data goes (assuming last row in A is also last in D) 
    endrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    'always start in the correct column 
    .Cells(.Cells(1, "D").End(xlDown).Row, "D").Offset(-1, 0).Activate 

    'loop through all data 
    Do While ActiveCell.Row < endrow 
     'Store cell of current base name 
     rownumber = ActiveCell.Row 
     ActiveCell.Offset(1, 0).Activate 

     'if next cell isn't empty, isn't past the end of the list, go to _ 
    outer loop 
     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=E" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=F" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=G" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=H" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=I" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     Else 
      Exit Do 
     End If 
     End If 
     End If 
     End If 
     End If 
     Loop 
End With 

End Sub 

Answer 2

Hier ist eine Methode Get & Transform (Excel 2016) oder Power Query (Excel 2010,2013)

Angenommen, dies ist Ihre Originaldaten:

• Zum Data -> Get & Transform (oder Power Query für frühere Versionen)

• Wählen Sie die Spalte Product # und ändern Sie den Typ in Text. (dies kann entfallen, wenn Sie sicher sind, dass keine Ihrer Artikel # 's jemals Text sein wird)

• UNPIVOT die anderen Spalten (die verschiedenen Größe Spalten)

• löschen Attribute Spalte (dies wird eine Liste der Spaltenüberschriften enthalten)
• Benennen Sie die verbleibenden Spalte Größe
• Schließen und speichern Sie die Abfrage

• bedingte Formatierung Spalte A Nehmen mit applies to: die gesamte Spalte von Daten abdecken (zB: 2 $ A $: $ 26 A $)

• CF Formel: =COUNTIF($A$2:$A2,$A2)>1

• CF Format: Zahlenformat: ;;;

Wenn Sie Zeilen aus Ihren ursprünglichen Daten hinzufügen oder löschen, können Sie die Abfrage und die Ergebnistabelle wird die automatische Aktualisierung Refresh.

Wenn Sie den Ergebnissen zusätzliche Spalten hinzufügen müssen, können Sie dies wahrscheinlich im Abfrageeditor tun.

Dankeschön an @TotsieMae für Hilfe bei der Bedingten Formatierungsformel. Siehe Get & Transform vs Conditional Format