複製粘貼VBA循環

運行我編寫的用於轉置數據集的VBA宏時遇到問題。主要目標是逐行獲取此數據集，並對其進行轉置，使列B：K成爲新行。複製粘貼VBA循環

這裏是什麼，我試圖做一個樣本：

http://i.imgur.com/4ywn17m.png

我已經寫了下面的VBA，但所有它做的是基本上創造了新的工作表「影子行」，這不是我想要的。

Sub LoopPaste() 

Dim i As Long 
Dim firstRow As Long 
Dim lastRow As Long 
Dim wb As Workbook 
Dim sheet1 As Worksheet 
Dim sheet2 As Worksheet 

Set wb = ThisWorkbook 
Set sheet1 = wb.Sheets("Sheet1") 
Set sheet2 = wb.Sheets("Sheet2") 

'Find the last row with data 
lastRow = sheet1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row 

'This is the beginning of the loop 
For i = firstRow To lastRow 

    'Copying Company 
    sheet2.Range("A" & i) = sheet1.Range("A" & i).Value 

    'Copying Employees 
    sheet2.Range("B" & i) = sheet1.Range("B" & i).Value 
    sheet2.Range("B" & 1 + i) = sheet1.Range("C" & i).Value 
    sheet2.Range("B" & 2 + i) = sheet1.Range("D" & i).Value 
    sheet2.Range("B" & 3 + i) = sheet1.Range("E" & i).Value 

Next i 

End Sub

我該如何獲得循環爲每位員工創建一個新行？

來源

2016-11-15 user7162412

你可以使用Range'的''的偏移（）'方法。要將行轉換爲列，反之亦然，來自源範圍左上角的偏移量（i，j）處的某些內容需要從目標範圍的左上角開始偏移（偏移量爲j，i）。 – jsheeran

我同意@jsheeran這將是最簡單的循環遍歷列和使用ThisWorkbook.Cells（Sheet1.Rows.Count，1）.End（xlUp）.Offset（1，0）.Value = positionInLoop（i） –

如果您先存儲在數組中，然後轉儲到工作表，則可獲得酷點積分！：D –

我很無聊，爲你想出了這個。 *應該*非常快速和無痛，但可能需要事先知道範圍。

Private Sub this() 

    Dim a() As Variant 

    a = Application.Transpose(Worksheets(1).Range("a1:p1").Value) 

    ThisWorkbook.Sheets("Sheet1").Range("a1:p1").Value = vbNullString 

    ThisWorkbook.Sheets("Sheet1").Range("a1:a55").Value2 = a 

End Sub

來源

2016-11-15 15:21:22

這應該給你的想法：

Sub test() 
    Dim src As Range, c As Range, target As Range 
    Dim curRow As Long 
    Set src = Intersect(Sheet1.Range("A1").CurrentRegion, Sheet1.Range("A1").CurrentRegion.Offset(1, 0)) 
    Set target = Sheet2.Range("a1") 
    curRow = src.Cells(1, 1).Row 
    For Each c In src.Cells 
     If c <> "" Then 
      target = c.Value 
      If c.Column = 1 Then 
       Set target = target.Offset(0, 1) 'next column 
      Else 
       Set target = target.Offset(1, 0) 'next row 
      End If 
     Else 
      'back to col 1 
      If target.Column <> 1 Then Set target = target.Offset(0, -target.Column + 1) 
     End If 
    Next c 

End Sub

來源

2016-11-15 16:24:31

複製粘貼VBA循環

回答

相關問題