Excel指定文件夹批量删除指定列

Excel-文件-选项-自定义功能区-开发工具（勾选）

开发工具-Visual Basic

注意：删除列时只能倒序删除

暂时还不会删除合并单元格：Selection.MergeCells

Sub Del_Col()
Application.DisplayAlerts = False
Dim myFiles As String
Dim myExcels As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
.AllowMultiSelect = False
.Title = "请选择要删除列的文件所在文件夹"
myFiles = .SelectedItems(1)
End With
myExcels = Dir(myFiles & "\" & "*.xls*")
Do While Len(myExcels) <> 0
Workbooks.Open (myFiles & "\" & myExcels)

Worksheets(1).Columns("H:H").Delete
Worksheets(1).Columns("F:F").Delete
Worksheets(1).Columns("E:E").Delete
Worksheets(1).Columns("C:C").Delete
Worksheets(1).Columns("B:B").Delete

ActiveWorkbook.Save
Workbooks(2).Close
myExcels = Dir
Loop
Application.DisplayAlerts = True
MsgBox "删除完成"
End Sub

 

厉害的excel方法：

Sub 取消合并且填充()
'
' 取消合并且填充 Macro
' 宏由 James 录制，时间: 2008-5-15
' 说明：不管三七二十一，一次性把当前工作表中所有的合并单元格都搞掂！宏从第一列开始逐列搜索直到遇到空列停止
' 宏会检查连续且有数据的所有格子，如果其中有空格，那就不同了：
' 对于数据中有空格：如果500行以下有空格，则宏忽略501行以下的格子。这个“500”在程序是可以看到的，可以手工改变它。

    Dim find As Boolean, i As Integer
    Application.CutCopyMode = False
    Cells(1, 1).Select
    While ActiveCell.Text <> ""
        find = False
        i = 1
        If Selection.MergeCells Then
            Selection.UnMerge
            i = Selection.Areas(1).Rows.Count
            If i > 1 Then Selection.FillDown
            If Selection.Areas(1).Columns.Count > 1 Then Selection.FillRight
        End If
        ActiveCell.Offset(i, 0).Range("A1").Select
        While (Selection.Range("A1").Text <> "" And Not find) Or (Selection.Range("A1").Text = "" And ActiveCell.Row() < 500)
            If Selection.MergeCells Then find = True
            If Not find Then ActiveCell.Offset(1, 0).Range("A1").Select
        Wend
        If Not find Then
            ActiveCell.Offset(0, 1).Range("A1").Select
            Cells(1, ActiveCell.Column()).Select
        End If
    Wend
End Sub

Private Sub CommandButton1_Click()
取消合并且填充
End Sub