Excel - 将包含空单元格的行移动到另一个工作表

Question

这是我第一次尝试VBA，所以我为我的无知道歉。情况如下:我有一个电子表格，由 4 列和 629 行组成。当我尝试做的是迭代每行中的 4 个单元格并检查是否有空白单元格。如果有一行包含空白单元格，我想从 Sheet1 中剪切它并将其粘贴到 Sheet2 中的第一个可用行中。

(理想情况下，列数和行数根据每个电子表格是动态的，但我不知道如何动态迭代行和列)

Sub Macro1()
'
' Macro1 Macro
' Move lines containing empty cells to sheet 2
'
' Keyboard Shortcut: Ctrl+r
'


Dim Continue As Boolean
Dim FirstRow As Long
Dim CurrentRow As Long
Dim LastRow As Long
Dim EmptySheetCount As Long


Dim Counter As Integer


'Initialize Variables

LContinue = True
FirstRow = 2
CurrentRow = FirstRow
LastRow = 629
EmptySheetCount = 1

'Sheets(Sheet1).Select

'Iterate through cells in each row until an empty one is found
While (CurrentRow <= LastRow)

    For Counter = 1 To 4

        If Sheet1.Cells(CurrentRow, Counter).Value = "" Then

            Sheet1.Cells(CurrentRow).EntireRow.Cut Sheet2.Cells(EmptySheetCount, "A")
            EmptySheetCount = EmptySheetCount + 1
            Counter = 1
            CurrentRow = CurrentRow + 1
            GoTo BREAK

        Else

            Counter = Counter + 1

        End If

        Counter = 1
BREAK:
    Next

Wend
End Sub

当我运行它时，我通常会在 Sheet1.Cells(CurrentRow, Counter).Value = ""区域出现错误，所以我知道我错误地引用了工作表。我尝试过工作表(Sheet1)、工作表(“Sheet1”)，但似乎没有任何效果。然而，当我更改为 Worksheets("Sheet1") 时，它会运行并卡住 Excel。

我知道我做错了很多事情，只是我知道的太少，不知道是什么。

提前非常感谢。对于糟糕的格式表示抱歉。

Answer 1

您的代码有一些问题，因此这里不是单独检查它们，而是一个基本的循环版本，它可以完成您所追求的任务。

Sub moveData()

    Dim wksData As Worksheet
    Dim wksDestination As Worksheet

    Dim lastColumn As Integer
    Dim lastRow As Integer

    Dim destinationRow As Integer

    Set wksData = Worksheets("Sheet1")
    Set wksDestination = Worksheets("Sheet2")

    destinationRow = 1

    lastColumn = wksData.Range("XFD1").End(xlToLeft).Column
    lastRow = wksData.Range("A1048576").End(xlUp).Row

    For i = lastRow To 1 Step -1    'go 'up' the worksheet to handle 'deletes'
        For j = 1 To lastColumn
            If wksData.Cells(i, j).Value = "" Then      'check for a blank cell in the current row
                'if there is a blank, cut the row
                wksData.Activate
                wksData.Range(Cells(i, 1), Cells(i, lastColumn)).Cut

                wksDestination.Activate
                wksDestination.Range(Cells(destinationRow, 1), Cells(destinationRow, lastColumn)).Select
                ActiveSheet.Paste

                'If required this code will delete the 'cut' row
                wksData.Rows(i).Delete shift:=xlUp

                'increment the output row
                destinationRow = destinationRow + 1

                Exit For     'no need to carry on with this loop as a blank was already found
            End If
        Next j
    Next i

    set wksData = Nothing
    set wksDestination = Nothing

End Sub

还有其他方法可以实现相同的结果，但这应该让您了解如何使用循环、工作表、范围等

lastColumn 和 lastRow 变量将查找给定列/行中的最后一列/行数据(即，在我的代码中，它会查找行 1 中的数据，以及 A 列中的最后一行数据)。

此外，您应该养成调试和单步调试代码的习惯，以识别错误并准确查看每一行正在做什么(这也将帮助您学习)。