如何复制和粘贴单元格，然后使用excel VBA以特定方式删除某些行？

Question

首先，我要说的是，在VBA方面，我不属于新手最低的级别。我目前在excel中只有一列数据，其中关于公司的信息在您沿列下降时以三行为一组的形式存储。数据分组如下（数据之间没有空行）：

CompanyA

www.CompanyA.com

CompanyA位置

CompanyB

www.CompanyB.com

CompanyB的位置...等

我需要创建一个代码，该代码将复制下面的单元格，将其粘贴到右侧的单元格，然后删除下面的行。然后复制下面的单元格，并将其粘贴到右边的两个单元格中，然后向下选择下一个单元格并为下一个三行数据集重复此步骤。如果这有助于解释我的想法，我在下面列出了我的糟糕的初稿。任何帮助将不胜感激。谢谢！

Sub Clean()

Do Until IsEmpty(ActiveCell.Value)

Range("A1").Activate

Selection.Offset(1, 0).Copy

Selection.Offset(0, 1).Paste

ActiveCell.Offset(1, 0).EntireRow.Delete xlShiftUp

Selection.Offset(1, 0).Copy

Selection.Offset(0, 2).Paste

ActiveCell.Offset(1, 0).EntireRow.Delete xlShiftUp

ActiveCell.Offset(1, 0).Select

Loop

End Sub

Answer 1

这可以帮助您完成所需的操作。这不是最好的解决方案，但是这将比您完成的操作稍快地遍历所有单元。

Sub test()
    Dim lRow As Long, i As Long
    Dim ws As Worksheet
    Dim RowsToDelete As Range

    Set ws = ActiveSheet
    With ws
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' Get the last row
        For i = lRow To 1 Step -4 
            .Cells(i - 2, 3) = .Cells(i, 1)
            .Cells(i - 2, 2) = .Cells(i - 1, 1)

            If RowsToDelete Is Nothing Then 'first 2 rows to be deleted
                Set RowsToDelete = Range(.Rows(i).EntireRow, .Rows(i - 1).EntireRow)
            Else 'append more rows with union
                Set RowsToDelete = Application.Union(RowsToDelete, .Rows(i).EntireRow, .Rows(i - 1).EntireRow)
            End If

        Next i

        If Not RowsToDelete Is Nothing Then 'if there is something to be deleted
            RowsToDelete.Delete
        End If
    End With
End Sub

Answer 2

我想我实际上只是想通了。我敢肯定这不是最优雅的解决方案，但它确实有效。好奇是否有人有更好的解决方案。谢谢！

Sub Clean（）

Range（“ A1”）。激活

直到IsEmpty（ActiveCell.Value）执行>

Selection.Offset(1, 0).Copy
Selection.Offset(0, 1).Select
ActiveCell.PasteSpecial xlPasteAll
ActiveCell.Offset(1, 0).EntireRow.Delete xlShiftUp
Selection.Offset(1, -1).Select
ActiveCell.Copy
Selection.Offset(-1, 2).Select
ActiveCell.PasteSpecial xlPasteAll
ActiveCell.Offset(1, 0).EntireRow.Delete xlShiftUp
Selection.Offset(1, -2).Select
循环

结束子