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 =“”区域周围出现错误，所以我知道我错误地引用了工作表。我已经尝试了Sheets（Sheet1），Worksheets（“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}中的最后一列数据}，以及1列中的最后一行数据。

此外，您应该养成调试和单步执行代码以识别错误并查看每行正在做什么的习惯（这也有助于您学习）。

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

＆＃39;享受

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

2 个答案: