Question

我需要将水平列表的一部分垂直化。我尝试过使用 TRANSPOSE 但没有成功。

使用一个VBA脚本我在四位或五位产品编号下方插入了空白行。我想移动（或复制/粘贴）图像中显示的值。

Excel列表

我修改了一个给我的VBA脚本（归功于TheAtomicOption），但是当我运行它时Excel停止：

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

有关如何解决以及如何改进脚本的任何建议？

编辑： A列只是Selection.End(xlDown).Select的支持列 B列是尺寸的计数器。它是为初始脚本插入新行。 C列是SKU /产品ID D列是我希望列出所有尺寸的列。列E-I和带SKU的行是列出现在的尺寸。

最终结果应该如何

编辑2：

解决方案，感谢来自QHarr的脚本。

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

我没有优化此代码，但看看是否有效。我添加了对工作簿和目标工作表的引用。您需要修改目标工作表名称。

添加了使用数据类型声明的变量。

单个Do循环，可以满足退出条件。

使用以下格式更正每行的语法和删除的偏移量： ActiveCell.Offset（0,1）.Formula =“= E（”＆amp; rownumber＆amp;“）”

你需要ActiveCell.Formula =“= E”＆amp; rownumber

注意：我假设您正在循环一列，因此只需要一个循环。您需要2个循环的原始代码Do While ActiveCell.Row＆lt;两个循环和ActiveCell.Formula =“= E”＆amp; rownumber + 1等。

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

以下是使用Get & Transform（Excel 2016）或Power Query（Excel 2010,2013）的方法

假设这是您的原始数据：

转到Data -> Get & Transform（或早期版本的Power Query）
选择Product＃列并将类型更改为Text。 （如果您确定您的所有产品都不是文字，则可以省略）
UNPIVOT 其他列（各种尺寸列）
删除Attribute列（这将包含列标题列表）
重命名剩余的列大小
关闭并保存查询

将条件格式应用于A列，applies to:覆盖整个数据列（例如：$ A $ 2：$ A $ 26）
CF公式：=COUNTIF($A$2:$A2,$A2)>1
CF格式：数字格式：;;;

如果您添加或删除原始数据中的行，您可以Refresh查询，结果表将自动更新。

如果您需要在结果中添加额外的列，您可以在查询编辑器中执行此操作。

致@TotsieMae以获取有关条件格式公式的帮助。见Get & Transform vs Conditional Format

在Excel中使水平列表垂直

2 个答案: