Как сделать мой код более эффективным в VBA

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:)