转置行后获得 6 列而不是 5 列

Question

编辑：我可以看到我的 post 是多么令人困惑，我很难描述我正在尝试做的事情。

我希望转置的最终结果看起来像屏幕截图中那样。问题是为什么我只需要 5 列却得到 6 列。Col D:H 中的值应该是开始和结束。但是相反，它们被移到了右边，Col C 有我不想要的值。以及为什么第二行出现下移的问题。

更多详细信息：每组 5 个单元格中的第一个值是序列号。细胞的下一个是测量值。我需要这些 5 人一组以保持原来的顺序。但是现在这些组正在从高序列号变为低序列号，我需要它与此相反。

原文Post：我试图让每 5 行转置为 5 列中它们自己的单行，但相反并保持降序。 A 列每 5 行中的第一行是序列号，您可以看到数字递减。我需要将 5 行放在一起，但要颠倒序号。

我很接近，但 D 列中的值是应该在 C 列中的连续序列号。C 列中的值似乎是一组 5 行中的最后一个值。谁能帮帮我。

My code:
Dim bottomB As Integer
bottomB = Range("A" & Rows.Count).End(xlUp).Row
Dim TR As Long
For TR = bottomB To 2 Step -5
Range(Cells(TR, "A"), Cells(TR + 5, "A")).Copy
Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR

Answer 1

Dim bottomB As Integer, b,c,d,i,j
Dim a as Collection
Dim TR As Long

Set a = New collection

bottomB = Range("A" & Rows.Count).End(xlUp).Row
' Put the data in a collection
For TR = bottomB To 2 Step -5
b=Range(Cells(TR, 1).Value
a.Add b.value
Next TR

Calculate 1/5th of total items in collection
c=Round((a.count)/5)
d=0

' You'll have to specify the start positions you want to paste
For i= Row1 to Row1+c
For j= Column1 to Column5

' Paste collection into cells
Worksheets("").Cells(i,j).Value=a(d)
d=d+1
Next i
Next j

Answer 2

我现在已经修改了您的代码以执行我认为您打算执行的操作。主要区别在于复制范围的定义。当然，如果您从第 1 行开始并添加 5，您将在第 6 行结束，这是下一组的开始，而不是当前组的结束。因此，正确的公式是将范围定义为行 1 到 1+4。如果您从最后一行开始并在其下方添加 4 个单元格，您将在该范围内只有一个值，因为最后一个单元格下方的所有单元格都是空白的。因此，您必须从比最后一个单元格高 4 个单元格的单元格开始。

' 139
Dim bottomB As Integer
Dim TR As Long

bottomB = Range("A" & Rows.Count).End(xlUp).Row - 4
For TR = bottomB To 2 Step -5
    Range(Cells(TR, "A"), Cells(TR + 4, "A")).Copy
    Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR

我认为我的调整可以解决您一直抱怨的问题。但是，我指出该代码过分依赖列中的最后一行作为集合的第四次测量。在这一点上的任何偏差都必须导致整个操作失败。

请考虑在循环之前添加 Application.ScreenUpdating = False，然后再次将属性设置为 True。这将大大加快操作速度，并避免数据快速变化时屏幕上的任何闪烁。

综上所述，您的代码将如下所示：-

Sub TransposeRows_2()
    ' 139
    Dim bottomB As Long
    Dim TR As Long
    
    bottomB = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For TR = (bottomB - 4) To 2 Step -5
        Range(Cells(TR, "A"), Cells(TR + 4, "A")).Copy
        Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Next TR
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub

转置行后获得 6 列而不是 5 列

Getting 6 columns instead of 5 after transposing rows

excel

vba

transpose