我有一张包含1800行和30列的Excel表格。我只需要大约7列，其名称永远不会改变（例如：“姓名”“姓氏”“标题”等）。
是否有可能设置过滤器来执行此操作？我只找到了一个带有2个标准的过滤器，而我需要7个。
是否有可用的插件/脚本，还是我需要自己编写一个？ （从未在excel中编程）
谷歌的结果与我的问题不同。 （也许我忽略了一些事情）
/编辑：
更多信息： 文件有这种格式示例： “姓名”，“标题”，“x”，“y”，“important1”，“important2”，“x”
和下一个： “姓名”，“标题”，“重要1”，“x”，“重要2”，“x”，“y”
我已将Tony的代码更改为以下内容：
Option Explicit
Sub DeleteOtherColumnsBeta()
Dim ColCrnt As Long
Dim ColsToKeepNum() As Long
Dim ColsToKeepName() As Variant
Dim InxKeep As Long
' Load names of columns that are to remain visible. The code below assumes
' these names are in ascending order by column number. These names must be
' exactly the same as in the worksheet: same case, same spaces, etc.
ColsToKeepName = Array(
"Teilbereich", "Anrede", "Titel", "Vorname", "Nachname", "Lehrveranstaltung", _
"Lehrveranstaltungsart", "Periode", "Bogen")
ReDim ColsToKeepNum(LBound(ColsToKeepName) To UBound(ColsToKeepName))
With Sheets("Sheet1") ' Replace "Sheet3" with the name of your sheet
' Locate columns to remain visible
ColCrnt = 1
For InxKeep = LBound(ColsToKeepName) To UBound(ColsToKeepName)
Do While ColsToKeepName(InxKeep) <> .Cells(1, ColCrnt).Value
ColCrnt = ColCrnt + 1
If ColCrnt > Columns.Count Then
Call MsgBox("Column headed """ & ColsToKeepName(InxKeep) & _
""" not found", vbOKOnly)
Exit Sub
End If
Loop
ColsToKeepNum(InxKeep) = ColCrnt
Call MsgBox("ColsToKeepNum(InxKeep)""" & ColsToKeepNum(InxKeep), vbOKOnly)
Next
' ColsToKeepNum() now contains a list of column numbers which are
' the columns to remain visible. All others are to be hidden.
ColCrnt = Columns.Count ' Last column processed
' Hide columns before first named column and between named columns
For InxKeep = UBound(ColsToKeepName) To LBound(ColsToKeepName)
If ColCrnt - 1 = ColsToKeepNum(InxKeep) Then
' There is no gap between last processed column and this column
' containing columns to be hidden
Else
.Range(.Cells(1, ColCrnt - 1), _
.Cells(1, ColsToKeepNum(InxKeep) + 1)).EntireColumn.Delete
End If
ColCrnt = ColsToKeepNum(InxKeep) ' Last processed column
Next
'Hide columns after last named column
.Range(.Cells(1, ColCrnt - 1), _
.Cells(1, Columns.Count)).EntireColumn.Delete
End With
End Sub
答案 0 :(得分：1)
过滤器只是用户隐藏行或列的简便方法。我相信下面的代码在您的情况下提供了合适的替代方案。
替换以下名称：
ColsToKeepName = Array("Name", "Addr", "Title", "Given", "Phone", _
"Home", "Mobile")
包含您希望保持可见的列的名称。您可以增加或减少名称的数量。名称必须按列号按升序排列，并且必须与工作表中的列标题完全匹配。
宏HideOtherColumns将隐藏所有其他列
宏RestoreColumns将恢复隐藏的列。
我认为代码非常简单，因此注释只能解释代码的用途。如果你不明白我在做什么，请回答问题。
希望这有帮助。
Option Explicit
Sub HideOtherColumns()
Dim ColCrnt As Long
Dim ColsToKeepNum() As Long
Dim ColsToKeepName() As Variant
Dim InxKeep As Long
' Load names of columns that are to remain visible. The code below assumes
' these names are in ascending order by column number. These names must be
' exactly the same as in the worksheet: same case, same spaces, etc.
ColsToKeepName = Array("Name", "Addr", "Title", "Given", "Phone", _
"Home", "Mobile")
ReDim ColsToKeepNum(LBound(ColsToKeepName) To UBound(ColsToKeepName))
With Sheets("Sheet3") ' Replace "Sheet3" with the name of your sheet
' Locate columns to remain visible
ColCrnt = 1
For InxKeep = LBound(ColsToKeepName) To UBound(ColsToKeepName)
Do While ColsToKeepName(InxKeep) <> .Cells(1, ColCrnt).Value
ColCrnt = ColCrnt + 1
If ColCrnt > Columns.Count Then
Call MsgBox("Column headed """ & ColsToKeepName(InxKeep) & _
""" not found", vbOKOnly)
Exit Sub
End If
Loop
ColsToKeepNum(InxKeep) = ColCrnt
Next
' ColsToKeepNum() now contains a list of column numbers which are
' the columns to remain visible. All others are to be hidden.
ColCrnt = 0 ' Last column processed
' Hide columns before first named column and between named columns
For InxKeep = LBound(ColsToKeepName) To UBound(ColsToKeepName)
If ColCrnt + 1 = ColsToKeepNum(InxKeep) Then
' There is no gap between last processed column and this column
' containing columns to be hidden
Else
.Range(.Cells(1, ColCrnt + 1), _
.Cells(1, ColsToKeepNum(InxKeep) - 1)).EntireColumn.Hidden = True
End If
ColCrnt = ColsToKeepNum(InxKeep) ' Last processed column
Next
'Hide columns after last named column
.Range(.Cells(1, ColCrnt + 1), _
.Cells(1, Columns.Count)).EntireColumn.Hidden = True
End With
End Sub
Sub RestoreColumns()
With Sheets("Sheet3")
.Range(.Cells(1, 1), .Cells(1, Columns.Count)).EntireColumn.Hidden = False
End With
End Sub
从与主工作簿相同的文件夹中的所有xls文件中删除列的新例程
请记住：删除列后，无法恢复。因此，请确保您拥有原始文件的副本。但是，此处的代码不会删除任何内容。相反，它输出了应该删除的内容的描述。我已经测试了这段代码，但我们需要在删除列之前先检查一下你的工作簿。
我将调用包含宏Master.xls的工作簿。此代码假定要删除列的所有工作簿与Master.xls位于同一文件夹中。此代码假定Master.xls包含名为DelCol的工作表。如果您不喜欢我选择的名称，请在代码中更改DelCol。
您将需要一个例程来查找文件夹中的所有Excel文件。我之前写过这篇文章：
Sub GetFileNameList(ByVal PathCrnt As String, ByVal FileSpec As String, _
ByRef FileNameList() As String)
' This routine sets FileNameList to the names of files within folder
' PathCrnt that match FileSpec. It uses function Dir$() to get the file names.
' I can find no documentation that says Dir$() gets file names in alphabetic
' order but I have not seen a different sequence in recent years
Dim AttCrnt As Long
Dim FileNameCrnt As String
Dim InxFNLCrnt As Long
ReDim FileNameList(1 To 100)
InxFNLCrnt = 0
' Ensure path name ends in a "\"
If Right(PathCrnt, 1) <> "\" Then
PathCrnt = PathCrnt & "\"
End If
' This Dir$ returns the name of the first file in
' folder PathCrnt that matches FileSpec.
FileNameCrnt = Dir$(PathCrnt & FileSpec)
Do While FileNameCrnt <> ""
' "Files" have attributes, for example: normal, to-be-archived, system,
' hidden, directory and label. It is unlikely that any directory will
' have an extension of XLS but it is not forbidden. More importantly,
' if the files have more than one extension so you have to use "*.*"
' instead of *.xls", Dir$ will return the names of directories. Labels
' can only appear in route directories and I have not bothered to test
' for them
AttCrnt = GetAttr(PathCrnt & FileNameCrnt)
If (AttCrnt And vbDirectory) <> 0 Then
' This "file" is a directory. Ignore
Else
' This "file" is a file
InxFNLCrnt = InxFNLCrnt + 1
If InxFNLCrnt > UBound(FileNameList) Then
' There is a lot of system activity behind "Redim Preserve". I reduce
' the number of Redim Preserves by adding new entries in chunks and
' using InxFNLCrnt to identify the next free entry.
ReDim Preserve FileNameList(1 To 100 + UBound(FileNameList))
End If
FileNameList(InxFNLCrnt) = FileNameCrnt
End If
' This Dir$ returns the name of the next file that matches
' the criteria specified in the initial call.
FileNameCrnt = Dir$
Loop
' Discard the unused entries
ReDim Preserve FileNameList(1 To InxFNLCrnt)
End Sub
尽管它的名称，下面的宏不会删除列。除了删除列之外，它还可以执宏检查文件夹中的每个工作表或每个工作簿。如果工作表不包含所有必需的列，则宏会报告它。如果工作表确实包含所有必需的列，则会报告要删除的列。
在您的系统上测试此宏并检查它是否令您满意。到那时我将测试删除代码。
Sub DeleteColumns()
Dim ColOtherCrnt As Long
Dim ColOtherEnd As Long
Dim ColOtherStart As Long
Dim ColOtherMax As Long
Dim ColsToDelete() As Long
Dim ColsToKeepFound() As Boolean
Dim ColsToKeepName() As Variant
Dim FileNameList() As String
Dim Found As Boolean
Dim InxCTDCrnt As Long
Dim InxCTDMax As Long
Dim InxCTK As Long
Dim InxFNLCrnt As Long
Dim InxWShtCrnt As Long
Dim Msg As String
Dim PathCrnt As String
Dim RowDelColNext As Long
Dim WBookMaster As Workbook
Dim WBookOther As Workbook
If Workbooks.Count > 1 Then
' It is easy to get into a muddle if there are multiple workbooks
' open at the start of a macro like this. Avoid the problem.
Call MsgBox("Please close all other workbooks", vbOKOnly)
Exit Sub
End If
Set WBookMaster = ActiveWorkbook
' Load names of columns that are NOT to be deleted These names must be
' actually the same as in the worksheet: same case, same spaces, etc.
' ##### Change this list as required. #####
ColsToKeepName = Array("Name", "Addr", "Title", "Given", "Phone", "Home", "Mobile")
' Get the name of the folder containing this workbook.
PathCrnt = ActiveWorkbook.Path & "\"
' Delete existing contents of worksheet DelCol and prepare for use
With Sheets("DelCol")
.Cells.EntireRow.Delete
.Cells(1, 1).Value = "Workbook"
.Cells(1, 2).Value = "Worksheet"
.Cells(1, 3).Value = "Comment"
.Range(.Cells(1, 1), .Cells(1, 3)).Font.Bold = True
End With
RowDelColNext = 2
' If you are using a later version of Excel, you will
' need to change the file specification.
Call GetFileNameList(PathCrnt, "*.xls", FileNameList)
For InxFNLCrnt = 1 To UBound(FileNameList)
If FileNameList(InxFNLCrnt) = WBookMaster.Name Then
' This workbook is the master
Set WBookOther = WBookMaster
Else
Set WBookOther = Workbooks.Open(PathCrnt & FileNameList(InxFNLCrnt))
End If
With WBookOther
' Store name of workbook
WBookMaster.Sheets("DelCol").Cells(RowDelColNext, 1).Value = .Name
RowDelColNext = RowDelColNext + 1
' Examine every worksheet in workbook
For InxWShtCrnt = 1 To .Worksheets.Count
With .Worksheets(InxWShtCrnt)
' Store name of worksheet
WBookMaster.Sheets("DelCol").Cells(RowDelColNext, 2).Value = .Name
RowDelColNext = RowDelColNext + 1
' #### Add code to ignore any workbooks
' #### you do not want examined
' .Range(Y).SpecialCells(X) finds a cell or cells of type X
' within range Y. ".Cells" means the entire worksheet.
' "xlCellTypeLastCell" means the last used cell or cells.
' I have extracted the column number. If ColOtherMax = 50
' then I know I need not consider columns 51, 52, etc.
ColOtherMax = .Cells.SpecialCells(xlCellTypeLastCell).Column
' Size array for one entry per name. Initialise to False
ReDim ColsToKeepFound(LBound(ColsToKeepName) To _
UBound(ColsToKeepName))
' Size array for the maximum possible number of columns.
ReDim ColsToDelete(1 To ColOtherMax)
InxCTDMax = 0 ' Array currently empty
' Example row 1 of every column
For ColOtherCrnt = ColOtherMax To 1 Step -1
' Match column header against names to keep
Found = False
For InxCTK = LBound(ColsToKeepName) To UBound(ColsToKeepName)
If .Cells(1, ColOtherCrnt).Value = ColsToKeepName(InxCTK) Then
Found = True
Exit For
End If
Next
' Record findings
If Found Then
' This column is to be kept
ColsToKeepFound(InxCTK) = True
Else
' This column is to be deleted
InxCTDMax = InxCTDMax + 1
ColsToDelete(InxCTDMax) = ColOtherCrnt
End If
Next
' Check all columns to be kept have been found
Found = True
For InxCTK = LBound(ColsToKeepName) To UBound(ColsToKeepName)
If Not ColsToKeepFound(InxCTK) Then
Found = False
Exit For
End If
Next
If Found Then
' All required columns have been found. Prepare to
' delete remaining columns
Msg = "Columns to be deleted:"
ColOtherStart = ColsToDelete(1)
ColOtherEnd = ColsToDelete(1)
For InxCTDCrnt = 2 To InxCTDMax
If ColsToDelete(InxCTDCrnt) + 1 = ColOtherStart Then
' Range continues
ColOtherStart = ColsToDelete(InxCTDCrnt)
Else
' End of last range. Start of new.
If ColOtherStart = ColOtherEnd Then
Msg = Msg & " " & ColOtherStart & " "
Else
Msg = Msg & " " & ColOtherStart & " to " & ColOtherEnd & " "
End If
ColOtherStart = ColsToDelete(InxCTDCrnt)
ColOtherEnd = ColsToDelete(InxCTDCrnt)
End If
Next
If ColOtherStart = ColOtherEnd Then
Msg = Msg & " " & ColOtherStart & " "
Else
Msg = Msg & " " & ColOtherStart & " to " & ColOtherEnd & " "
End If
WBookMaster.Sheets("DelCol").Cells(RowDelColNext, 2).Value = Msg
RowDelColNext = RowDelColNext + 1
Else
' Not all required columns found.
Msg = "The following required columns were not found:"
For InxCTK = LBound(ColsToKeepName) To UBound(ColsToKeepName)
If Not ColsToKeepFound(InxCTK) Then
Msg = Msg & " " & ColsToKeepName(InxCTK)
End If
Next
WBookMaster.Sheets("DelCol").Cells(RowDelColNext, 3).Value = Msg
RowDelColNext = RowDelColNext + 1
End If
End With
Next
If FileNameList(InxFNLCrnt) = WBookMaster.Name Then
' This workbook is the master
Else
.Close SaveChanges:=False ' Close the workbook without saving it
End If
Set WBookOther = Nothing ' Clear reference to workbook
End With
Next
End Sub
关于第二次例程的评论
不要担心使用Java。我曾经精通C语言，能够理解大多数C派生语言的语法。
新代码不要求列以任何特定顺序排列，因为您说序列在所有工作簿中都不相同。
新代码和旧代码都需要完全匹配。有许多技术允许部分匹配，但我不知道哪个是合适的。例如：
if Lcase(X) = Lcase(Y) then表示“NAME”，“name”和“Name”都匹配。if Replace(X," ","") = Replace(Y," ","") then表示“名字”和“名字”匹配。Like是执行通配符匹配的运算符。Instr这是另一种可能性，但我怀疑Like会给您更多灵活性。但是我对InStr和Like感到有点不舒服。它们允许您将“addr”与“address”和“home addr”匹配，但也将“name”与“enamel”匹配。 “珐琅”这个词似乎不太可能出现在你的任何标题行中，但我希望你能看到我的担忧。Lcase(Replace(X," ",""))。新代码的目的是测试例程的效果而不删除任何内容。如果您要查找部分匹配，我建议您将输出更改为工作表“ColDel”以包含匹配名称的列表。
您无需一次性处理每个工作簿。你可以处理简单的工作簿并将它们移到别处，让你专注于困难的工作簿。