我正在尝试编写一小段代码来创建一个新的工作表,并从第2行第1列到第4列的源工作表中的表中插入值。一旦它到达结尾,我需要它循环到下一行并重新开始。
我遇到的问题是下面的代码循环回到新工作表的第1行,并且数据被覆盖。有没有一种简单的方法让我的循环开始在第一个空行上?
[ 2
Sub SAX()
Dim wsSource As Excel.Worksheet, wsData As Excel.Worksheet
Dim r As Long, c As Long
Set wsData = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsData.Name = "Data"
Set wsSource = ThisWorkbook.Worksheets("Header")
Application.DisplayAlerts = False
r = 2
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
For c = 1 To 4
wsData.Cells(c * 1, 1).Value = wsSource.Cells(r, c).Value
Next c
ThisWorkbook.Activate
r = r + 1
Loop
Application.DisplayAlerts = True
End Sub
答案 0 :(得分:0)
试试这个......你实际上需要两个Row值,一个用于数据,一个用于输出:
Sub SAX()
Dim wsSource As Worksheet, wsData As Worksheet
Dim lDataRow As Long, lCol As Long, lOut as Long
Set wsData = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsData.Name = "Data"
Set wsSource = ThisWorkbook.Worksheets("Header")
Application.DisplayAlerts = False
lDataRow = 2
lOut = 1
Do
For lCol = 1 To 4
wsData.Cells(lOut, 1) = wsSource.Cells(lDataRow, lCol)
Next lCol
lDataRow = lDataRow + 1
lOut = lOut + 1
Loop Until Len(Trim(wsSource.Cells(lDataRow, 1))) = 0
Application.DisplayAlerts = True
End Sub
答案 1 :(得分:0)
你想要的是这个,假设(从截图中)你正在使用结构化的ListObject
表:
Sub SAX()
Dim wsSource As Excel.Worksheet, wsData As Excel.Worksheet
Dim i as Long
Dim tbl As ListObject
Dim vals As Variant
With ThisWorkbook
Set wsData = Sheets.Add(After:=.Sheets(.Sheets.Count))
Set wsSource = .Worksheets("Header")
End With
wsData.Name = "Data"
'## Get a handle on the Table object
Set tbl = wsSource.ListObjects(1) 'Modify if needed
Application.DisplayAlerts = False
i = 1 'which row we start putting data on wsData
'## Iterate each row of data in the Table
For Each rng In tbl.DataBodyRange.Rows
'## Dump this row's values in to an array, and transpose it
vals = Application.Transpose(rng.Value)
'## Put the array's values in an appropriately sized range on the wsData sheet:
wsData.Cells(i, 1).Resize(UBound(vals)).Value = vals
'## Increment the destination row number:
i = i + UBound(vals)
Next
Application.DisplayAlerts = True
End Sub
在这里,我们转置rng.Value
,以便我们可以将其放入列中。我们将其存储在vals
数组中。然后,我们使用vals
数组来确定将值放置在的范围的大小"数据"表格,并使用vals
数组的大小来增加我们的i
变量,该变量告诉我们将下一行行的数据放在何处。
或者,甚至更简单:
For i = 1 to tbl.DataBodyRange.Cells.Count
wsData.Cells(i, 1).Value = tbl.DataBodyRange.Cells(i).Value
Next
这是因为范围是按行/列索引的,所以我们开始计算顶部/左边的单元格#1,然后换行到第二行并重新开始计数,例如,"单元格索引&# 34;在此示例表中:
只需迭代Cells.Count
即可轻松将其放入单行或列中。
答案 2 :(得分:0)
创建数组并一次写入所有数据会更有效。
Sub SAX()
Dim Data, v
Dim x As Long, y As Long
With ThisWorkbook.Worksheets("Header")
With .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
x = WorksheetFunction.RoundUp(.Cells.Count / 4, 0)
ReDim Data(1 To x, 1 To 4)
x = 1
For Each v In .Cells
If y = 4 Then
x = x + 1
y = 1
Else
y = y + 1
End If
Data(x, y) = v
Next
End With
End With
With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
.Name = "Data"
.Range("A1:D1") = Array(1, 2, 3, 4)
.Range("A2:D2").Resize(UBound(Data, 1)).Value = Data
End With
End Sub