2015-07-21 58 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

謝謝。它運作良好! –