2017年4月5日水曜日

【 Excel 】シートの最後のセル(xlLastCell)をリセットする

シートの行や列を削除しても使用範囲(UsedRange)は元の範囲のままとなっており、実際の使用範囲を反映するように手動で調整するのは面倒である。
これをプログラムで行う。

Sub ResetLastCell()
' シートの xlLastCell の位置を再調整する
' 削除範囲にデータがあっても確認せずに削除するので、注意。
'【 使い方 】LastCell にしたいセルを選択して呼び出す。実行後、ブックを開き直すこと。
  Dim wCell As Range, wRet As Integer
  Dim wNewRow As Long, wNewCol As Long, wCurRow As Long, wCurCol As Long
 
  Set wCell = ActiveCell
  wRet = MsgBox( _
          wCell.Address + "を LastCell にします。" + vbCrLf  + vbCrLf + _
          "他のセルを指定するには「No」を押してください。", _
          vbYesNoCancel, "LastCell の位置を再調")
  If (wRet = vbCancel) Then GoTo ResetLastCellExit
  If (wRet = vbNo) Then
    Set wCell = Application.InputBox(Prompt:="新しい LastCell を選択してください。", Type:=8)
    If (wCell Is Nothing) Then GoTo ResetLastCellExit
    On Error GoTo 0
  End If
  wCell.Parent.Activate
  wNewRow = wCell.Row + 1:    wNewCol = wCell.Column + 1
  Set wCell = wCell.SpecialCells(xlLastCell)
  wCurRow = wCell.Row:    wCurCol = wCell.Column
  ' 削除による参照先エラーを避けるため、Cells で指定する。
  If (wCurRow > wNewRow) Then           ' 行を調整
    Range(Cells(wCurRow, wCurCol), Cells(wCurRow, wCurCol)).EntireRow.Cut Destination:=Range(Cells(wNewRow, wNewCol), Cells(wNewRow, wNewCol)).EntireRow
    Range(Cells(wNewRow, wNewCol), Cells(wCurRow, wCurCol)).EntireRow.Delete Shift:=xlUp
  End If
  If (wCurCol > wNewCol) Then           ' 列を調整
    Range(Cells(wCurRow, wCurCol), Cells(wCurRow, wCurCol)).EntireColumn.Cut Destination:=Range(Cells(wNewRow, wNewCol), Cells(wNewRow, wNewCol)).EntireColumn
    Range(Cells(wCurRow, wCurCol), Cells(wNewRow, wNewCol)).EntireColumn.Delete Shift:=xlLeft
  End If
  MsgBox "ブックを保存し、開き直してください。", vbOKOnly
ResetLastCellExit:
End Sub


0 件のコメント: