让我的代码在 VBA 中更高效

Question

Top Table

What Top Table should looks like afterward

Bottom Table

What Bottom Table should looks like afterwards

我有以下代码，基本上从第一个表中复制最后两行，然后插入下面的行。然后我将从插入的行中删除某些部分的单元格。 如您所见，有一个模式，4,5,6....7,8,9....,11,12,13....等

然后，它会去底部表格复制“DOS”上面的行并插入到下面。然后，它会从上面的行中复制“OUT”列中的单元格并将其粘贴到下面的行中。

我遇到的第一个问题是 Union 最多只能接受 30 个参数，但我有超过 30 个 rng。

我想使用 for 循环或其他东西使我的代码更高效

Sub BajaFresh_Update()
        Range("A1").Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Union(ActiveCell.EntireRow, ActiveCell.Resize(1).Offset(-1).EntireRow).Copy
        ActiveCell.Resize(1).Offset(1).EntireRow.Insert Shift:=xlDown
        Application.CutCopyMode = False


        Set rng1 = ActiveCell.Offset(1, 4)
        Set rng2 = ActiveCell.Offset(2, 4)
        Set rng3 = ActiveCell.Offset(1, 5)
        Set rng4 = ActiveCell.Offset(2, 5)
        Set rng5 = ActiveCell.Offset(1, 6)
        Set rng6 = ActiveCell.Offset(2, 6)
        Set rng7 = ActiveCell.Offset(1, 8)
        Set rng8 = ActiveCell.Offset(2, 8)
        Set rng9 = ActiveCell.Offset(1, 9)
        Set rng10 = ActiveCell.Offset(2, 9)
        Set rng11 = ActiveCell.Offset(1, 10)
        Set rng12 = ActiveCell.Offset(2, 10)
        Set rng13 = ActiveCell.Offset(1, 12)
        Set rng14 = ActiveCell.Offset(2, 12)
        Set rng15 = ActiveCell.Offset(1, 13)
        Set rng16 = ActiveCell.Offset(2, 13)
        Set rng17 = ActiveCell.Offset(1, 14)
        Set rng18 = ActiveCell.Offset(2, 14)
        Set rng19 = ActiveCell.Offset(1, 16)
        Set rng20 = ActiveCell.Offset(2, 16)
        Set rng21 = ActiveCell.Offset(1, 17)
        Set rng22 = ActiveCell.Offset(2, 17)
        Set rng23 = ActiveCell.Offset(1, 18)
        Set rng24 = ActiveCell.Offset(2, 18)
        Set rng25 = ActiveCell.Offset(1, 20)
        Set rng26 = ActiveCell.Offset(2, 20)
        Set rng27 = ActiveCell.Offset(1, 21)
        Set rng28 = ActiveCell.Offset(2, 21)
        Set rng29 = ActiveCell.Offset(1, 22)
        Set rng30 = ActiveCell.Offset(2, 22)
        Set rng31 = ActiveCell.Offset(1, 24)
        Set rng32 = ActiveCell.Offset(2, 24)
        Set rng33 = ActiveCell.Offset(2, 25)
        Set rng34 = ActiveCell.Offset(2, 25)
        Set rng35 = ActiveCell.Offset(2, 26)
        Set rng36 = ActiveCell.Offset(2, 26)


        Union(rng1, rng2, rng3, rng4, rng5, rng6, rng7, rng8, rng9, rng10, rng11, rng12, rng13, rng14, rng15, rng16, rng17, rng18, rng19, rng20, rng21, rng22, rng23, rng24, rng25, rng26, rng27, rng28, rng29, rng30).ClearContents
        Union(rng32, rng33, rng34, rng35, rng36).ClearContents
        ActiveCell.End(xlDown).Select
        ActiveCell.End(xlDown).Select
        ActiveCell.Offset(-6).EntireRow.Copy
        ActiveCell.Offset(-5).Select
        ActiveCell.EntireRow.Insert Shift:=xlDown
        Application.CutCopyMode = False

        Set copy1 = ActiveCell.Offset(-2, 5)
        Set copy2 = ActiveCell.Offset(-2, 9)
        Set copy3 = ActiveCell.Offset(-2, 13)
        Set copy4 = ActiveCell.Offset(-2, 17)
        Set copy5 = ActiveCell.Offset(-2, 21)
        Set copy6 = ActiveCell.Offset(-2, 25)
        Set paste1 = ActiveCell.Offset(-1, 5)
        Set paste2 = ActiveCell.Offset(-1, 9)
        Set paste3 = ActiveCell.Offset(-1, 13)
        Set paste4 = ActiveCell.Offset(-1, 17)
        Set paste5 = ActiveCell.Offset(-1, 21)
        Set paste6 = ActiveCell.Offset(-1, 25)
        copy1.Copy
        ActiveSheet.Paste paste1
        copy2.Copy
        ActiveSheet.Paste paste2
        copy3.Copy
        ActiveSheet.Paste paste3
        copy4.Copy
        ActiveSheet.Paste paste4
        copy5.Copy
        ActiveSheet.Paste paste5
        copy6.Copy
        ActiveSheet.Paste paste6




        End Sub

Answer 1

强烈建议在评论中接受@Craners 的建议。删除 .Select 和 .ActiveCell 的所有实例。我把它们留在这里，但你应该努力删除它们。

---

我相信您可以使用它来将您的 30 个范围四舍五入为一个变量：MyUnion。循环完成后，您只需引用 MyUnion 即可，其中包含所有单独的范围（MyUnion.ClearContents、MyUnion.Copy 等）

您可以将类似的逻辑应用于其他循环。不过，这将淘汰您的第一个，也是最大的循环！

Dim MyUnion As Range, iRow As Integer, iCol As Integer

For iCol = 4 To 26
    If iCol <> 7 Or iCol <> 15 Or iCol <> 19 Or iCol <> 23 Then 'Skip these columns
        For iRow = 1 To 2
            If MyUnion Is Nothing Then
                Set MyUnion = ActiveCell.Offset(iRow, iCol)
            Else
                Set MyUnion = Union(MyUnion, ActiveCell.Offset(iRow, iCol))
            End If
        Next iRow
    End If
Next iCol

Msgbox "REMOVE .SELECT OR ELSE CRANER WILL FIND YOU" vbCritical

GL :)