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

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

（理想情况下，列的数量和行数是基于每个电子表格的dynamic，但我不知道如何dynamic迭代通过行和列）

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”），似乎没有任何工作。 当我切换到工作表（“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 

还有其他方法可以达到相同的效果，但是这应该给你和如何使用loops ， sheets ， ranges等的想法。

lastColumn和lastRowvariables将查找给定列/行中的最后一列/数据行（即，在我的代码中，它查找第1行中的最后一列数据，以及列A的最后一行数据）。

另外，你应该养成通过代码debugging和步进的习惯来识别错误，并且准确地看到每一行正在做什么（这也会帮助你学习）。

Answer 2

你可能会发现这个用法。 它使用数组variables来存储要移动的行中单元格的值。 它不使用剪切和粘贴，所以只传输数据值，代码不需要激活所需的表单。 目标行的顺序与原始工作表上的行相同。 用于查找行和列中使用的最后一个单元格的方法比给出的其他答案更优雅。

 Option Explicit Public Sub test_moveData() Dim wksData As Worksheet Dim wksDestination As Worksheet Set wksData = shtSheet1 ' Use the Codename "shtSheet1" for the worksheet. ie the value of the sheet property that is displayed as "(Name)" Set wksDestination = shtSheet2 moveData wksData, wksDestination End Sub Public Sub moveData(wksData As Worksheet, wksDestination As Worksheet) Dim ilastColumn As Integer Dim ilastRow As Integer Dim iRow As Long Dim iColumn As Long Dim iDestinationRowNumber As Integer Dim MyArray() As Variant Dim rngRowsToDelete As Range iDestinationRowNumber = 1 ilastColumn = wksData.Cells(1, wksData.Columns.Count).End(xlToLeft).Column ilastRow = wksData.Cells(wksData.Rows.Count, 1).End(xlUp).Row ReDim MyArray(1, ilastColumn) Set rngRowsToDelete = Nothing For iRow = 1 To ilastRow Step 1 'No need to go 'up' the worksheet to handle 'deletes' For iColumn = 1 To ilastColumn If wksData.Cells(iRow, iColumn).Value = "" Then 'check for a blank cell in the current row MyArray = wksData.Range(wksData.Cells(iRow, 1), wksData.Cells(iRow, ilastColumn)).Value wksDestination.Range(wksDestination.Cells(iDestinationRowNumber, 1), wksDestination.Cells(iDestinationRowNumber, ilastColumn) _ ).Value = MyArray 'Store the rows to be deleted If rngRowsToDelete Is Nothing Then Set rngRowsToDelete = wksData.Rows(iRow) Else Set rngRowsToDelete = Union(rngRowsToDelete, wksData.Rows(iRow)) End If 'increment the output row iDestinationRowNumber = iDestinationRowNumber + 1 Exit For 'no need to carry on with this loop as a blank was already found End If Next iColumn Next iRow If Not rngRowsToDelete Is Nothing Then rngRowsToDelete.EntireRow.Delete shift:=xlUp End If Set rngRowsToDelete = Nothing Set wksData = Nothing Set wksDestination = Nothing End Sub 

' 请享用