Question

我发现了类似的结果，但实际上并没有解决我的问题，所以如果这个问题的开头似乎很熟悉，请原谅我。我试图下拉一系列行来找到第一个空行 - 这一点我能做到

Sub findblank()

Dim xrow As Integer, xcol As Integer
xrow = 1 xcol = 1

Do Until Cells(xrow, xcol).value = ""
      Cells(xrow, xcol).Select
      xrow = xrow + 1
Loop

End Sub

这是让我难以理解的下一步，没有使用可怕的sendkeys。我想选择空白单元格上方的所有数据行，然后复制它们。然后我将它们粘贴到一个新的工作表中，并对原始工作表中的另一个区域重复此过程。

然后我将返回原始工作表，选择最后一个单元格，重置xrow / xcol并继续向下。

基本上我正在处理数据块，其间有大量空白，并将它们复制到新表中，我想在数据之间只放一个空行。

提前致谢。

Answer 1

您可以执行以下操作（同时，尽量避免依赖Select或Activate方法）。

此方法使用Range object's End property定义范围对象。由于您正在使用连续范围，因此这应该是您的选择。然后为Copy方法的目标定义工作表变量，瞧：

Sub findblank()
Dim rng as Range
Dim destSheet as Worksheet
Dim xrow As Integer, xcol As Integer

For xcol = 1 to 10 '// This will let you run this loop on multiple columns
    xrow = 1 
    '// Define your contiguous range using the End property:
    Set rng = Range(Cells(xrow, xcol), Cells(xrow, xcol).End(xlDown))

    '// Define the destination for the copy/paste
    Set destSheet = Worksheets("Another worksheet")   '// Modify as needed

    '// Copy & paste to another worksheet
    rng.Copy destSheet.Range(Cells(1, xCol))

End Sub

或者，如果你想使用一个循环结构（虽然如果你只是按照上面的建议使用范围.End方法似乎没有必要）：

Sub findblank()
Dim rng as Range
Dim destSheet as Worksheet
Dim xrow As Integer, xcol As Integer
xrow = 1 
xcol = 1

'// Define the initial range
Set rng = Range(Cells(xrow, xcol))

'// Define the destination for the copy/paste
Set destSheet = Worksheets("Another worksheet")   '// Modify as needed

'// Loop until you find an empty cell
Do Until Cells(xrow + 1, xcol).value = ""
      xrow = xrow + 1
Loop

'// Once you exit the loop, just resize the rng object variable:
Set rng = rng.Resize(xrow, 1)

'// Copy & paste to another worksheet
rng.Copy destSheet.Range("A1")


End Sub

循环找到空单元格然后复制上面

1 个答案: