Как перебрать столбцы заданное количество раз

Question

Моя верхняя строка заполнена значениями. Я хотел бы вставить два столбца между каждым из этих значений, до последней непустой ячейки в моей верхней строке.

Я застрял там в моем коде:

Sub AddCol()
'
' AddCol Macro
'

For i = 1 To 2

    Sheets("CashFlow").Select
    Columns(i + 1).Select
    Selection.Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Next i

End Sub

Answer 1

Пара вещей.

a) Вам нужно получить значение для количества столбцов, чтобы вы могли выполнить цикл и добавить

b) При циклическом цикле переходите от самого высокого к низшему, потому что вы добавляете столбцы, если вы делаете циклический переход от самого низкого к самому высокому, это повлияет на ваши счетчики, и в итоге вы не будете проходить по всему набору заголовков.

См. Ниже код:

Sub ColumnsAdd()

    Dim lCol As Long
    Dim i As Long
    Dim myWS As Worksheet

    Set myWS = Sheets("CashFlow")

    lCol = myWS.Cells(1, myWS.Columns.Count).End(xlToLeft).Column

    For i = lCol To 1 Step -1
        myWS.Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        myWS.Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Next i

End Sub

Answer 2

Это будет работать для вас:

Sub AddCol() ' ' AddCol Macro '

With Thisworkbook.Worksheets("CashFlow")

For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column * 3 Step 3


    .Columns(i + 1).Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    .Columns(i + 1).Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Next i

End With    

End Sub

Answer 3

Более короткий путь:

.Columns(i + 1).Resize(, 2).Insert Shift:=x1ToRight, CopyOrigin:=xlFormatFromLeftOrAbove