rand(life)
[vba] 마지막 데이터 셀이 시트끝행으로 설정되는 경우 본문
이동 옵션 (F5 키 - 옵션)은 여러모로 쓸 모가 많은 기능이다.
그런데 가끔씩, "마지막 데이터 셀"이 의도대로 기능하지 않을 때가 있다. 우리 생각에는 이 기능이
"현재 데이터 중에서 맨 마지막행,열에 있는 셀"을 보여준다고 생각하는데
실제로 해보면
"지금까지 이 시트에서 기록되었던 셀 중에서 맨 마지막행.열에 있는 셀"을 보여주는 것이다.
즉, 한번이라도 값이 기록된 적이 있었던 셀 전체 중에서 맨 끝셀을 보여준다.
예를 들어,
A1셀에 데이터가 있는 상태에서
A1048576 셀 (A열의 맨 마지막 행이다)에 데이터를 기록했다가 삭제하면
이동 옵션에서 마지막 데이터 셀을 선택하고 확인하면
일반인의 생각에는 A1셀로 이동해야겠지만 실제로는 A1048576 셀로 이동한다.
물론, 이 현상은 파일을 저장하고 닫고 난 뒤 다시 열면 없어지는 현상이다.
그런데 어쩌다보면 이 현상이 없어지지 않고 계속될 때가 있다.
방법은 두 가지인데,
1. 데이터 있는 부분만 복사해서 새로운 파일에 붙여넣는 방법
2. 매크로를 이용하는 방법이다.
일반적으로는 1의 방법이 간편하다. 하지만 1의 방법을 사용할 수 없는 경우도 있다.
그럴때 사용하기 위해, 아래 매크로를 사용한다.
마지막데이터셀오류수정.txtOption Explicit
Public mnu As CommandBarButton
Sub ClearExcessRowsAndColumns()
Dim ar As Range, r As Long, c As Long, tr As Long, tc As Long, x As Range
Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As Integer
Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
Dim shp As Shape
If ActiveWorkbook Is Nothing Then Exit Sub
On Error Resume Next
For Each wksWks In ActiveWorkbook.Worksheets
Err.Clear
Set ur = Nothing
'Store worksheet protection settings and unprotect if protected.
blProtCont = wksWks.ProtectContents
blProtDO = wksWks.ProtectDrawingObjects
blProtScen = wksWks.ProtectScenarios
wksWks.Unprotect ""
If Err.Number = 1004 Then
Err.Clear
MsgBox "'" & wksWks.Name & _
"' is protected with a password and cannot be checked." _
, vbInformation
Else
Application.StatusBar = "Checking " & wksWks.Name & _
", Please Wait..."
r = 0
c = 0
'Determine if the sheet contains both formulas and constants
Set ur = Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), _
wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
'If both fails, try constants only
If Err.Number = 1004 Then
Err.Clear
Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
End If
'If constants fails then set it to formulas
If Err.Number = 1004 Then
Err.Clear
Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
End If
'If there is still an error then the worksheet is empty
If Err.Number <> 0 Then
Err.Clear
If wksWks.UsedRange.Address <> "$A$1" Then
wksWks.UsedRange.EntireRow.Hidden = False
wksWks.UsedRange.EntireColumn.Hidden = False
wksWks.UsedRange.EntireRow.RowHeight = _
IIf(wksWks.StandardHeight <> 12.75, 12.75, 13)
wksWks.UsedRange.EntireColumn.ColumnWidth = 10
wksWks.UsedRange.EntireRow.Clear
'Reset column width which can also _
cause the lastcell to be innacurate
wksWks.UsedRange.EntireColumn.ColumnWidth = _
wksWks.StandardWidth
'Reset row height which can also cause the _
lastcell to be innacurate
If wksWks.StandardHeight < 1 Then
wksWks.UsedRange.EntireRow.RowHeight = 12.75
Else
wksWks.UsedRange.EntireRow.RowHeight = _
wksWks.StandardHeight
End If
Else
Set ur = Nothing
End If
End If
'On Error GoTo 0
If Not ur Is Nothing Then
arCount = ur.Areas.Count
'determine the last column and row that contains data or formula
For Each ar In ur.Areas
i = i + 1
tr = ar.Range("A1").Row + ar.Rows.Count - 1
tc = ar.Range("A1").Column + ar.Columns.Count - 1
If tc > c Then c = tc
If tr > r Then r = tr
Next
'Determine the area covered by shapes
'so we don't remove shading behind shapes
For Each shp In wksWks.Shapes
tr = shp.BottomRightCell.Row
tc = shp.BottomRightCell.Column
If tc > c Then c = tc
If tr > r Then r = tr
Next
Application.StatusBar = "Clearing Excess Cells in " & _
wksWks.Name & ", Please Wait..."
If r < wksWks.Rows.Count And r < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row Then
Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Cells.SpecialCells(xlCellTypeLastCell).Row)
ur.EntireRow.Hidden = False
ur.EntireRow.RowHeight = IIf(wksWks.StandardHeight <> 12.75, 12.75, 13)
'Reset row height which can also cause the _
lastcell to be innacurate
If wksWks.StandardHeight < 1 Then
ur.RowHeight = 12.75
Else
ur.RowHeight = wksWks.StandardHeight
End If
Set x = ur.Dependents
If Err.Number = 0 Then
ur.Clear
Else
Err.Clear
ur.Delete
End If
End If
If c < wksWks.Columns.Count And c < wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column Then
Set ur = wksWks.Range(wksWks.Cells(1, c + 1), _
wksWks.Cells(1, wksWks.Cells.SpecialCells(xlCellTypeLastCell).Column)).EntireColumn
ur.EntireColumn.Hidden = False
ur.ColumnWidth = 18
'Reset column width which can _
also cause the lastcell to be innacurate
ur.EntireColumn.ColumnWidth = _
wksWks.StandardWidth
Set x = ur.Dependents
If Err.Number = 0 Then
ur.Clear
Else
Err.Clear
ur.Delete
End If
End If
End If
End If
'Reset protection.
wksWks.Protect "", blProtDO, blProtCont, blProtScen
Err.Clear
Next
Application.StatusBar = False
MsgBox "'" & ActiveWorkbook.Name & _
"' has been cleared of excess formatting." & Chr(13) & _
"You must save the file to keep the changes.", vbInformation
End Sub
코드를 살펴보면 알겠지만, 내가 만든 것이 아니다. 출처는 여기이다.
XSFormatCleaner.xla파일로도 첨부한다. 사용법은 위의 출처에 나와있다. (영어 주의)
