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 

'享受