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

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

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

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

После этого я попробовал еще один, используя Union. Это не работает так же хорошо: 

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
3 3
excel vba excel-vba

3 ответа:

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

5

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

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

Я перевел код Мэттбоя как самый чистый

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

Использует Можно ли заполнить массив номерами строк, которые соответствуют определенному критерию, без цикла? 

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
1