Question

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

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

我遇到的第一个问题是，联盟最多只接受30个论点，但是我有30余卢比。

我想使用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：）

使我的代码在VBA中更高效

1 个答案: