Question

我试图创建一个VBA宏来将黄色高亮显示单元格移动到绿色单元格，就像下图中的方式一样。我试图使用偏移代码，但我不能用它来抵消一系列单元格，A3 - I3到J2 - R2。

信息行的数量可以是40到900行，所以我需要能够继续移动单元格的东西，直到A-I列中没有更多信息。

理想的结果显示可以根据需要反映这样的行数。

我仍然是VBA世界的新手，并为其他建议创造了一些，但我似乎无法想象这一点。

---- 2018年1月22日更新----

我实际上用这些代码解决了这个问题。我有4作为因为有时候前5行不需要移动。在我测试时找到了这个

Sub ()
Dim i As Long, lastRow As Long, rngToMove As Range

lastRow = Worksheets("cxl macro test").Cells(1048576, 1).End(xlUp).Row

For i = 4 To lastRow
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 10) = Worksheets("cxl macro test").Cells(i - 1, 1)
        Worksheets("cxl macro test").Cells(i - 1, 1) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 11) = Worksheets("cxl macro test").Cells(i - 1, 2)
        Worksheets("cxl macro test").Cells(i - 1, 2) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 12) = Worksheets("cxl macro test").Cells(i - 1, 3)
        Worksheets("cxl macro test").Cells(i - 1, 3) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 13) = Worksheets("cxl macro test").Cells(i - 1, 4)
        Worksheets("cxl macro test").Cells(i - 1, 4) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 14) = Worksheets("cxl macro test").Cells(i - 1, 5)
        Worksheets("cxl macro test").Cells(i - 1, 5) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 15) = Worksheets("cxl macro test").Cells(i - 1, 6)
        Worksheets("cxl macro test").Cells(i - 1, 6) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 16) = Worksheets("cxl macro test").Cells(i - 1, 7)
        Worksheets("cxl macro test").Cells(i - 1, 7) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 17) = Worksheets("cxl macro test").Cells(i - 1, 8)
        Worksheets("cxl macro test").Cells(i - 1, 8) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 18) = Worksheets("cxl macro test").Cells(i - 1, 9)
        Worksheets("cxl macro test").Cells(i - 1, 9) = ""
    End If
Next i

虽然由于某种原因，我无法查看最后一行内容，但它并没有移动所需的行。最后一行物理数据是526但是当我使用一个较小的例子，最后一行是70时，我得到相同的结果。

有谁知道我应该如何调整它？

Answer 1

试试这个。

Sub CopyCells()
    Dim i As Long, lastRow As Long, rngToMove As Range

    lastRow = Worksheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row

    For i = 1 To lastRow - 1 Step 3
        Set rngToMove = Range("A" & i + 1 & ":I" & i + 1)
        rngToMove.Cut Destination:=Range("J" & i)
    Next i
End Sub

假设：

数据从第1行开始，包含在A到I列中
有一个用于分隔数据块的空白行

Answer 2

我会在这里使用for循环。

ur = Sheets(YourSheetName).UsedRange.Rows.Count
For Each rw In ur
If sheets(YourSheetname).Range("A" & ur+1).Value = "" Then
'YOUR COPY PASTE CODE HERE'
else
End If
Next rw

Answer 3

这是通过在我调整的代码

末尾添加+2来解决的

lastRow =工作表（“cxl宏测试”）。单元格（Rows.Count，“A”）。结束（xlUp）.Row + 2

谢谢大家帮忙!!!

将一系列单元格移动到活动工作表内的另一个位置

3 个答案: