[英]Copy Paste VBA loop
I have an issue when running my VBA macro that I've written to transpose a dataset. 运行我编写的VBA宏以转置数据集时出现问题。 The main goal is to take this dataset row by row, and transpose it so columns B:K are new rows.
主要目标是逐行获取此数据集,并将其转置,以便列B:K为新行。
Here is a sample of what I am trying to do: 这是我想要做的一个示例:
http://i.imgur.com/4ywn17m.png http://i.imgur.com/4ywn17m.png
I've written the following VBA, but all it is doing is basically creating a "shadow row" in a new sheet, which isn't what I want. 我写过以下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
How can I get the loop to create a new row for each employee? 如何让循环为每个员工创建一个新行?
I got bored and came up with this for you. 我感到无聊,并为你想出了这个。 * Should * be pretty quick and painless, but might require knowing the ranges before hand.
*应该*非常快速和无痛,但可能需要事先了解范围。
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
This should give you the idea: 这应该给你的想法:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.