過濾器是用戶隱藏行或列的簡單方法。我相信下面的代碼在你的情況下提供了一個合適的選擇。
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意味着「名稱」，「名稱」和「名稱」全部匹配。if Replace(X," ","") = Replace(Y," ","") then意味着「first name」和「firstname」匹配。Like是執行通配符匹配的運算符。- 您已經發現
Instr這是另一種可能性，雖然我懷疑Like會給你更多的靈活性。不過，我對InStr和Like有點不舒服。他們將允許您將「addr」與「address」和「home addr」相匹配，而「name」則與「enamel」匹配。 「琺琅」一詞似乎不太可能出現在您的任何標題行中，但我希望您能看到我的擔憂。
- 如果您使用的Excel版本比我高，那麼您可以通過其所有的靈活性訪問Regex。
- 您可以嵌套呼叫，例如：
Lcase(Replace(X," ",""))。
新代碼的目的是在不刪除任何東西的情況下測試例程的效果。如果您要查找部分匹配，我建議您將輸出更改爲工作表「ColDel」以包含匹配名稱的列表。
您不必一次就可以處理每個工作簿。你可以處理簡單的工作簿並將它們移動到其他地方，讓你專注於困難的工作簿。
您可以按多個條件排序。什麼版本的Excel？你的問題還不是很清楚，你想完成什麼？ – Raystafarian 2012-02-24 15:22:59
使用數據透視表。在2007年或2010年擊中插入功能區，pivottable。 – Jesse 2012-02-24 17:39:49
你想隱藏特定的列，或刪除它們嗎？託尼的答案似乎自動隱藏它們。或者你希望他們不在你的工作表中？ – datatoo 2012-02-26 16:27:16