FC2ブログ

最終行と最終行列の削除

2017–05–27 (Sat) 15:21
「最終行と最終行列の削除」
重宝するマクロの一つです!

Sub 最終行と列の削除()
With ActiveSheet.UsedRange
MRow = .Rows(.Rows.count).Row
MCol = .Columns(.Columns.count).Column
End With

With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

For i = 1 To MaxCol
If Cells(MaxRow, i).MergeCells Then
If MaxRow < Cells(MaxRow, i).MergeArea.Rows.count - 1 + MaxRow Then
MaxRow = Cells(MaxRow, i).MergeArea.Rows.count - 1 + MaxRow
End If
End If
Next

For i = 1 To MaxRow
If Cells(i, MaxCol).MergeCells Then
If MaxCol < Cells(i, MaxCol).MergeArea.Columns.count - 1 + MaxCol Then
MaxCol = Cells(i, MaxCol).MergeArea.Columns.count - 1 + MaxCol
End If
End If
Next

If Cells(MaxRow, MaxCol).MergeCells Then
If MaxRow < Cells(MaxRow, MaxCol).MergeArea.Rows.count - 1 + MaxRow Then
MaxRow = Cells(MaxRow, MaxCol).MergeArea.Rows.count - 1 + MaxRow
End If
If MaxCol < Cells(MaxRow, MaxCol).MergeArea.Columns.count - 1 + MaxCol Then
MaxCol = Cells(MaxRow, MaxCol).MergeArea.Columns.count - 1 + MaxCol
End If
End If

If MRow - MaxRow <> 0 Then
ActiveSheet.Rows(MaxRow + 1 & ":" & MRow).select
Dim rc As Integer
rc = MsgBox("選択した箇所を削除しますか?", vbYesNo + vbQuestion, "確認")
If rc = vbYes Then
ActiveSheet.Rows(MaxRow + 1 & ":" & MRow).Delete

End If

End If
If MCol - MaxCol <> 0 Then
rc = MsgBox("選択した箇所を削除しますか?", vbYesNo + vbQuestion, "確認")
ActiveSheet.Columns(MaxCol + 1).Resize(, MCol).select
If rc = vbYes Then
ActiveSheet.Columns(MaxCol + 1).Resize(, MCol).Delete

End If

End If
End Sub
スポンサーサイト



« 年度の表示 | HOME |  枠線マクロ »

コメント

コメントの投稿

 
管理者にだけ表示

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク