如何将数据从水平复制并粘贴到垂直？

Question

我原始电子表格中的数据是水平列出的。 例如：

A B C D E F G

1 A a 2 3 4 5 6

2 B b 1 3 4 5 6

3 C c 1 2 4 6 7

我想以垂直的方式安排这张桌子。如下所示：

A B C

1 A a 2

2 A a 3

3 A a 4

4 A a 5

5 A a 6

6 B b 1

7 B b 3

。 我已经弄清楚如何找到最后一行来粘贴值

 Range("A1").End(xlDown).Offset(1,0) 

我在如何进行正确的循环以找到每个数字并以垂直方式相应地粘贴它们，并与A列和B列匹配。

提前致谢。

Answer 1

试试这个

Sub ArrangeVertical()

Dim MyWorkbook As Workbook
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet

Dim myRow As Long
Dim rowPointer As Long
Dim columnPointer As Long
Dim lastColumn As Long
Dim LastRow As Long

Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set Sheet1 = MyWorkbook.Worksheets("SaleTeam3")
Set Sheet2 = MyWorkbook.Worksheets("SaleTeam4")
myRow = 1

LastRow = Sheet1.Cells(Rows.Count, "a").End(xlUp).Row

For rowPointer = 1 To LastRow
    lastColumn = Sheet1.Cells(rowPointer, Columns.Count).End(xlToLeft).Column
    For columnPointer = 3 To lastColumn
        Sheet2.Cells(myRow, 1).Value = Sheet1.Cells(rowPointer, 1).Value
        Sheet2.Cells(myRow, 2).Value = Sheet1.Cells(rowPointer, 2).Value
        Sheet2.Cells(myRow, 3).Value = Sheet1.Cells(rowPointer, columnPointer).Value
        myRow = myRow + 1
    Next columnPointer
Next rowPointer



End Sub

Answer 2

这将扫描工作表调用＆＃34; Sheet1＆＃34; 和在名为＆＃34; sheet2＆＃34; 的工作表中输出结果，我＆＃ 39; ve 标记了更改这些名称的位置，以便您可以根据需要拒绝它：

Sub NeferZhang()

Dim Ws As Worksheet, _
    Wop As Worksheet, _
    Wrow As Integer, _
    FirstRun As Boolean

FirstRun = True
'-------Change name here-------
Set Ws = ThisWorkbook.Sheets("Sheet1")
'-------Change name here-------
Set Wop = ThisWorkbook.Sheets("Sheet2")

Wop.Cells.ClearContents
Wop.Cells.ClearFormats

For i = 1 To Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
    For k = 3 To Ws.Range("A" & i).End(xlToRight).Column
        Wrow = Wop.Range("A" & Wop.Rows.Count).End(xlUp).Row + 1
        If Wrow <> 2 And Not FirstRun Then
            'Nothing to change
        Else
            'Only change at the first try, to write on first row
            Wrow = 1
            FirstRun = False
        End If
        Wop.Range("C" & Wrow + (k - 3)).Value = Ws.Cells(i, k).Value
    Next k
    'Copy A and B columns
    Wop.Range("A" & Wrow & ":B" & Wrow + (k - 4)).Value = Ws.Range(Ws.Cells(i, 1), Ws.Cells(i, 2)).Value
Next i

Set Ws = Nothing
Set Wop = Nothing

End Sub

Answer 3

你真的需要它作为VBA代码吗？您只需复制数据，然后右键单击＆gt;即可粘贴数据。置。那将完成这项工作。

在VBA中，这样的事情应该有效：

Public Sub copyTrans()
    Range("A1:G3").Copy
    Range("A4").PasteSpecial Transpose:=True
End Sub

（而不是Range("A1:G3")，您当然可以使用不同的函数来查找最后一个单元格）

修改 对不起，我读的你的问题有点太快了。转置将转换为：

A a 2 3 4 5 6
B b 1 3 4 5 6 
C c 1 2 4 6 7

到此：

A B C
a b c
2 1 1
3 3 2
4 4 4
5 5 6
6 6 7