3

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

この後、ユニオンを使って別のものを試しました。それもうまくいきません：

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
4

3 に答える 3

3

このように後進できます。また、削除する前に列を選択する必要はありません。すぐに削除できます。

For i = ((LastColumn \ 4) * 4) To 4 Step -4
   ws.Columns(i).Delete Shift:=xlToLeft
Next i
于 2013-10-09T07:29:30.900 に答える
1

私はマットボーイのコードを最もきれいなものとして支持しました

範囲ループを回避して、提案どおりに配列を使用することは可能ですが、配列の生成はトリッキーであるため、キックのためにこれをさらに投稿します

用途ループせずに、特定の条件に一致する行番号で配列を埋めることは可能ですか?

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
于 2013-10-11T13:40:08.007 に答える