2015-07-21 127 views
0

我的原始电子表格中的数据是水平列出的。 例如:如何将数据从水平复制并粘贴到垂直?

ABCDEFG

A中的2 3 4 5 6

B B 1 2 3 4 5 6

C C 1 2 4 6 7

我想安排这张桌子在垂直方式。这样下面:

ABC

A中的2

A中的3

甲4

A中的5

A中的6

B B 1

B B 3

。 我已经找到了如何找到最后一排粘贴值

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

而且我堆放在如何做正确的循环来找到每个号码和他们在垂直的方式相应地粘贴,还与列匹配A和B.

在此先感谢。

+0

你尝试过什么?你发布的代码并不多。你所有的价值都在不同的列上? – L42

回答

0

这将扫描片叫“工作表Sheet1”输出结果的表称为“Sheet2的”,我已经标在哪里更改这些名称所以你可以拒绝它为你的需要:

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 
0

你真的需要这个VBA代码吗?您可以简单地复制数据,然后通过右键单击>移调来粘贴。这将完成这项工作。

在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 
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 

Before After

+0

谢谢。它运作良好! –