Excel VBA - 循環到下一個可用的空白單元格

Question

我正在嘗試編寫一小段代碼來創建一個新的工作表，並從第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

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數組來確定將值放在“Data”表上的范圍的大小，並使用vals數組的大小來遞增我們的i變量，它告訴我們將下一行的數據放在何處。

或者，甚至更簡單：

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

這是因為范圍是按行/列索引的，所以我們開始計算頂部/左側的單元格＃1，然后換行到第二行並重新開始計數，例如，“單元索引”在此示例表中：

只需迭代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