Excel宏从文件夹中的所有文件中删除特定列答案

【问题标题】：Excel macro to delete specific column from all files in a folderExcel宏从文件夹中的所有文件中删除特定列
【发布时间】：2014-08-13 15:20:50
【问题描述】：

我有一个包含 200 个文本文件的文件夹，我想从每个文件中删除两列并以与以前相同的名称和格式保存。手动我可以通过在 excel 中打开每个文件然后删除该列并通过更改文件扩展名保存回来来做到这一点。任何人都可以帮助一些excel宏。谢谢

【问题讨论】：

我对 excel 宏很陌生。如果你能帮忙，我需要 VBA 代码
如果您只需要完成它，但又不想自己努力，可以聘请开发人员。我们需要付出一些努力，这样才能成为一种学习体验。
@heywahab .. Ondkloss 是正确的，但会给你这个。请参阅下面的示例

标签： excel directory

【解决方案1】：

Sub ConvertFileToCSV(sPath As String)
Dim wbToConvert As Workbook
Workbooks.OpenText Filename:= _
              sPath, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
              xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
               , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
              Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
              Array(9, 1)), TrailingMinusNumbers:=True
Set wbToConvert = ActiveWorkbook
With wbToConvert
    With .Sheets(1)
        .Columns("B:B").EntireColumn.Delete
        .Columns("C:C").EntireColumn.Delete
    End With

    .SaveAs Filename:=WorksheetFunction.Substitute(sPath, ".txt", ".csv"), FileFormat:=xlCSV, CreateBackup:=False
    .Close savechanges:=False
End With

End Sub

这将让您将文件名传递给函数，打开工作簿，删除 B 和 C 列，然后将其保存为 csv。从那里我们只需要调用它，我们可以使用这样的例程来完成

Sub ConvertEach()
Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False
'Create objects to get a listing of all files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
'Prompt user to select a directory
Do
    Problem = False
    Set ShellApp = CreateObject("Shell.Application"). _
                   Browseforfolder(0, "Please choose a folder", 0, "c:\\")
    On Error Resume Next
    'Evaluate if directory is valid
    Directory = ShellApp.self.Path
    Set SubFolder = fso.GetFolder(Directory).Files
    If Err.Number <> 0 Then
        If MsgBox("You did not choose a valid directory!" & vbCrLf & _
                  "Would you like to try again?", vbYesNoCancel, _
                  "Directory Required") <> vbYes Then Exit Sub
        Problem = True
    End If
    On Error GoTo 0
Loop Until Problem = False
'Look through each file
For Each File In SubFolder
    If Not Excludes(Right(File.Path, 3)) = True Then
        If Right(LCase(File.Path), 3) = "txt" Then
            Call ConvertFileToCSV(LCase(File.Path))
        End If
    End If
Next
End Sub

【讨论】：

【解决方案2】：

下面的示例使用 ActiveX 按钮和添加到 Module.Module1 类的代码

您需要为 FileSystemObject 添加引用 ..Add Scripting Reference Required

在 Module1 类中（你可以运行这个宏）..

    Sub Macro1()
    Dim sFldr As String
    Dim fso As Scripting.FileSystemObject
    Dim fsoFile As Scripting.File
    Dim fsoFldr As Scripting.Folder

    Set fso = New Scripting.FileSystemObject

    sFldr = "C:\Temp\stackoverflow\excel\"

    Set fsoFldr = fso.GetFolder(sFldr)

    For Each fsoFile In fsoFldr.Files

        Workbooks.Open Filename:=fsoFile.Path
        Columns("E:F").Select
        Selection.Delete Shift:=xlToLeft
        ActiveWorkbook.Save
        ActiveWindow.Close
    Next fsoFile

End Sub

添加了 ActiveX 按钮来调用 Sheet1 上的上述宏 ..

Private Sub CommandButton1_Click()

    Call Module1.Macro1

End Sub

【讨论】：