Question

我正在尝试编写一小段代码来创建一个新的工作表，并从第2行第1列到第4列的源工作表中的表中插入值。一旦它到达结尾，我需要它循环到下一行并重新开始。

我遇到的问题是下面的代码循环回到新工作表的第1行，并且数据被覆盖。有没有一种简单的方法让我的循环开始在第一个空行上？

[ Desired Output 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

Answer 1

试试这个......你实际上需要两个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

Answer 2

你想要的是这个，假设（从截图中）你正在使用结构化的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数组来确定将值放置在的范围的大小＆＃34;数据＆＃34;表格，并使用vals数组的大小来增加我们的i变量，该变量告诉我们将下一行行的数据放在何处。

或者，甚至更简单：

For i = 1 to tbl.DataBodyRange.Cells.Count
    wsData.Cells(i, 1).Value = tbl.DataBodyRange.Cells(i).Value
Next

这是因为范围是按行/列索引的，所以我们开始计算顶部/左边的单元格＃1，然后换行到第二行并重新开始计数，例如，＆＃34;单元格索引＆＃ 34;在此示例表中：

只需迭代Cells.Count即可轻松将其放入单行或列中。

Answer 3

创建数组并一次写入所有数据会更有效。

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

Excel VBA - 循环到下一个可用的空白单元格

3 个答案: