필터는 사용자가 행이나 열을 숨길 수있는 쉬운 방법입니다. 나는 아래의 코드가 귀하의 상황에 적합한 대안을 제공한다고 믿습니다. 당신이 계속 표시하고자하는 열의 이름과
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을 변경하십시오.
폴더의 모든 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
댓글은 자바를 사용에 대해 걱정하지 마십시오. 한때 C에 능통했고 대부분의 C 파생 언어의 구문을 이해할 수있었습니다.
새 코드에서는 시퀀스가 모든 통합 문서에서 동일하지 않기 때문에 특정 시퀀스에 열이 필요하지 않습니다.
새 코드와 기존 코드 모두 정확히 일치해야합니다. 부분 일치를 허용하는 많은 기술이 있지만 어느 것이 적합할지 모릅니다. 예 :
if Lcase(X) = Lcase(Y) then은 "NAME", "name"및 "Name"이 모두 일치한다는 것을 의미합니다.if Replace(X," ","") = Replace(Y," ","") then은 "이름"과 "성"이 일치 함을 의미합니다.Like은 와일드 카드 일치를 수행하는 연산자입니다.- 이 더 많은 유연성을 제공 할 것으로 생각되지만 다른 가능성이있는
Instr을 발견했습니다. 그러나 나는 InStr과 Like으로 약간 불편합니다. 그들은 "addr"을 "address"및 "home addr"와 "name"을 "enamel"과 일치시킬 수 있습니다. "에나멜"이라는 단어가 머리말 행에 나타날 가능성은 거의 없지만 내 관심사가 보이기를 바랍니다.
- 나보다 많은 Excel 버전을 사용하는 경우 모든 유연성을 갖춘 Regex에 액세스 할 수 있습니다.
- 전화를 중첩 할 수 있습니다 (예 :
Lcase(Replace(X," ",""))).
새로운 코드의 목적은 아무 것도 삭제하지 않고 루틴의 효과를 테스트하는 것입니다. 부분 일치를 찾으려면 결과를 워크 시트 "ColDel"로 변경하여 일치하는 이름의 목록을 포함시키는 것이 좋습니다.
모든 통합 문서를 한 번에 처리 할 필요는 없습니다. 쉬운 통합 문서를 처리하고 다른 곳으로 이동하여 어려운 문제에 집중할 수 있습니다.
여러 기준으로 정렬 할 수 있습니다. 어떤 버전의 Excel? 또한 귀하의 질문은 명확하지 않습니다, 당신은 무엇을 성취하려고합니까? – Raystafarian
피벗 테이블을 사용하십시오. 2007 년 또는 2010 년에 피봇 테이블 리본을 쳤습니다. – Jesse
특정 열을 숨기거나 제거 하시겠습니까? 토니의 대답은 그들을 숨기는 것을 자동화하는 것처럼 보입니다. 아니면 그들이 당신의 시트에 있지 않기를 바랍니까? – datatoo