Как выбрать и удалить каждый третий столбец

Question

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

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

Sub DeleteMultipleColumns() 
Dim i As Integer 
Dim LastColumn As Long 
Dim ws As Worksheet 

Set ws = Sheets("Arkusz2") 
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column 
ws.Activate 
For i = 4 To (LastColumn - 2) 
    ws.Columns(i).Select 
    Selection.Delete Shift:=xlToLeft 
    i = i + 3 
Next i 
End Sub 

После этого я попробовал другой, используя Союз. Она не работает, а также:

Sub DeleteMultipleColumns() 
Dim i As Integer 
Dim LastColumn As Long 
Dim ws As Worksheet 

Set ws = Sheets("Arkusz2") 
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column 
ws.Activate 
For i = 4 To (LastColumn - 2) 
    Application.Union.Columns(i).Select 
    i = i + 3 
Next i 
Selection.Delete Shift:=xlToLeft 
End Sub 

Так как это сделать?

Моя новая идея - попробовать массив. Есть ли у меня другие возможности?

Это код, который я реализовал после ваших очень хороших ответов (спасибо: sam092, meohow, mattboy):

Sub DeleteMultipleColumns() 
Dim i As Integer 
Dim LastColumn As Long 
Dim ws As Worksheet 
Application.ScreenUpdating = False 
Set ws = Sheets("Arkusz2") 
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column - 2 
For i = LastColumn To 4 Step -3 
    ws.Columns(i).Delete Shift:=xlToLeft 
Next i 
Application.ScreenUpdating = True 
End Sub 

Answer 1

в обратном направлении. Начните удаление справа. Я думаю, вы знаете, как изменить свой код.

Answer 2

Вы можете вернуться в обратном направлении. Кроме того, вам не нужно выбирать столбец перед удалением, вы можете просто удалить его сразу.

For i = ((LastColumn \ 4) * 4) To 4 Step -4 
    ws.Columns(i).Delete Shift:=xlToLeft 
Next i 

Answer 3

Я upvoted код Mattboy в качестве чистейшего

можно избежать петли диапазона и использовать массив, как вы предлагаете, хотя я этот пост больше для пинков, как генерация массива сложно

Использует Is it possible to fill an array with row numbers which match a certain criteria without looping?

Sub OneinThree() 
Dim ws As Worksheet 
Dim rng1 As Range 
Dim x As String 
Set ws = ActiveSheet 
Set rng1 = Cells(1, ws.Cells(1, Columns.Count).End(xlToLeft).Column - 2) 
x = Join(Filter(Application.Evaluate("=IF(MOD(column(A1:" & rng1.Address & "),3)=0,address(1,column(a1:" & rng1.Address & ")),""x"")"), "x", False), ",") 
If Len(x) > 0 Then ws.Range(x).EntireColumn.Delete 
End Sub