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”），似乎没有任何工作。但是，当我切换到工作表（“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和lastRow变量会发现最后在给定的列/行中的列/行数据（即，在我的代码中，它找到行1中的最后一列数据以及列A中的最后一行数据）。另外，你应该养成调试和逐步浏览代码的习惯来识别错误，并且确切地看到每一行正在做什么（这也会帮助你学习）。

Answer 2

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

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 

'享受