Удалить столбцы после
Существует только бесконечное количество способов, как вы могли бы решить, какие столбцы удалять, поэтому я выбрал один.
Удалить все столбцы, содержащие указанную строку в заголовке
В этом примере кода используются ActiveWorkbook, ActiveSheet, строка «DEL» и быстрая версия.Вы можете изменить это в разделе Константы.
Быстрая версия решает проблему, вычисляя диапазон, столбцы которого затем будут удалены за один раз, а медленная версия удаляет столбцы один за другим.
'*******************************************************************************
' Purpose: Deletes only columns appearing after a specified column AND
' containing a specified string in their header.
'*******************************************************************************
Sub DeleteColumnsAfter()
Const cStrWB As String = "" ' e.g. "Master.xls", if "" then ActiveWorkbook.
Const cStrWS As String = "" ' e.g. "Sheet1", if "" then Activesheet.
Const cStrStart As String = "Master Column" ' Search Column Title
Const cStrSearch As String = "DEL" ' Search String ("" for all columns.)
Const cBlnFast As Boolean = True ' False for deleting column by column.
Dim objWs As Worksheet ' Worksheet to be processed.
Dim objStart As Range ' Cell range after which columns are to be deleted.
Dim objEnd As Range ' Last cell range in objSearch.
Dim objSearch As Range ' Range where cStrSearch will be searched for.
Dim objDEL As Range ' Range to be deleted.
Dim intCol As Integer ' Columns Counter
Dim strError As String ' Error Help String
' Determine the worksheet to be processed.
On Error GoTo WsHandler
If cStrWB = "" Then ' Unspecified workbook
If cStrWS = "" Then ' Unspecified worksheet
Set objWs = ActiveWorkbook.ActiveSheet
Else ' Specified worksheet
Set objWs = ActiveWorkbook.Worksheets(cStrWS)
End If
Else ' Specified workbook
If cStrWS = "" Then ' Unspecified worksheet
Set objWs = Workbooks(cStrWB).ActiveSheet
Else ' Specified worksheet
Set objWs = Workbooks(cStrWB).Worksheets(cStrWS)
End If
End If
On Error GoTo 0
With objWs
' Find the cell range containing cStrStart.
Set objStart = .Cells.Find(what:=cStrStart, _
After:=.Cells(.Rows.Count, .Columns.Count), LookIn:=xlFormulas, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
' Check if cStrStart is not found.
If objStart Is Nothing Then GoTo StartExit
' Find the last non-empty cell in the row of objStart.
Set objEnd = .Cells.Find(what:="*", _
After:=.Cells(objStart.Row + 1, 1), LookIn:=xlFormulas, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
' Determine the range where cStrSearch is to be searched for.
Set objSearch = .Range(objStart.Offset(0, 1), objEnd)
If cBlnFast = True Then ' Fast Version
' Determine the first cell where cStrSearch is found.
For intCol = 1 To objSearch.Cells.Count
' cStrSearch IS found (vbTextCompare i.e. case-insensitive e.g. DEL=Del)
If InStr(1, objSearch(intCol).Text, cStrSearch, vbTextCompare) <> 0 Then
' Creating a reference to the cell where cStrSearch is found.
' Other cells will be added in the following For Next loop creating
' the range whose columns will be deleted.
Set objDEL = .Cells(1, objSearch.Column + intCol - 1)
' Resize search range to a range starting after the found cStrSearch.
Set objSearch = .Range(objStart.Offset(0, intCol + 1), objEnd)
Exit For
End If
Next
' Check if cStrSearch is not found.
If objDEL Is Nothing Then GoTo ColumnsHandler
' Add the rest of the cells where cStrSearch is found.
For intCol = 1 To objSearch.Cells.Count
If InStr(1, objSearch(intCol).Text, cStrSearch, vbTextCompare) <> 0 Then
' This wouldn't have worked before because objDEL was Nothing.
Set objDEL = Union(objDEL, .Cells(1, objSearch.Column + intCol - 1))
End If
Next
' Delete the columns.
objDEL.EntireColumn.Delete
' Tip: Replace Delete with Select or Hide for testing.
Else ' SLow Version (cBlnFast = False)
For Each objDEL In objSearch
' cStrSearch IS found (vbTextCompare i.e. case-insensitive e.g. DEL=Del)
If InStr(1, objDEL.Text, cStrSearch, vbTextCompare) <> 0 Then _
objDEL.EntireColumn.Delete
' Tip: Replace Delete with Select or Hide for testing.
Next
End If ' cBlnFast
End With ' Worksheet
ProcedureExit:
Set objDEL = Nothing
Set objSearch = Nothing
StartExit:
Set objStart = Nothing
WsExit:
Set objWs = Nothing
Exit Sub
' Errors
ColumnsHandler:
MsgBox "No columnns to delete."
GoTo ProcedureExit
StartHandler:
MsgBox "Could not find '" & cStrStart & "' in worksheet '" & objWs.Name & "'."
GoTo StartExit
WsHandler:
MsgBox "Something went wrong with the Worksheet or the Workbook."
GoTo WsExit
End Sub