如何选择和删除每个第3列

I have a set of data where every third column is the same. I want to leave only the first column and other which are the same must be deleted.

我有一组数据，其中每第三列是相同的。我想只留下第一列，必须删除其他相同的列。

At first I tried this code but it deleted wrong columns because in every loop other columns positions were altered.

起初我尝试了这段代码但它删除了错误的列，因为在每个循环中其他列的位置都被更改了。

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

After this I tried another one using Union. It doesn't work as well:

在此之后我尝试了另一个使用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

So how to do it?

那怎么办呢？

My new idea is to try with an array. Do I have other options?

我的新想法是尝试使用数组。我还有其他选择吗？

This is the code that I've implemented after your very good answers (thanks: sam092, meohow, mattboy):

这是我在你的非常好的答案之后实现的代码（谢谢：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 个解决方案

#1

Reverse the direction. Start deleting from the right. I think you know how to modify your code

扭转方向。从右侧开始删除。我想你知道如何修改你的代码

#2

You can go backwards like this. Also, you don't need to select the column before deleting, you can simply delete it right away.

你可以像这样倒退。此外，您不需要在删除之前选择列，您可以立即删除它。

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

#3

I upvoted Mattboy's code as the cleanest

我赞成Mattboy的代码是最干净的

It is possible to avoid the range loop and use an array as you suggest, although I post this more for kicks as the array generation is tricky

可以避免使用范围循环并按照你的建议使用数组，尽管我发布了更多内容，因为数组生成很棘手

Uses 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

#1