SHIFT+CTRL+↓でもいいのですが
エクセルでデータを処理する場合に、セル範囲を厳密に選ぶのは結構面倒です。例えば、2000行のデータがあったとして、間に空白セルも含まれている、というような場合、SHIFT+CTRL+→キーだと繰り返し操作が必要にります。また、各種マクロの前処理として選択範囲をデータのある範囲に狭めたい場合があります。
そこで、選択範囲をデータのある範囲に縮小するマクロを作成しました。
使用方法
セル範囲、行、列、またはシート全体を選択し、マクロを実行します。コード
Sub shrinkSelectionRange() 'シート全体が選択されている場合 If Selection.Columns.Count = Columns.Count And Selection.Rows.Count = Rows.Count Then 'Usedrangeを使って手抜き ActiveSheet.UsedRange.Select Else 'そうでない場合は行列方向に個別処理 Call shrinkSelectionRow Call shrinkSelectionColumn End If End Sub Sub shrinkSelectionRow() Dim maxRowCount As Long, minRowCount As Long Dim response As Integer With Selection '列が選択されているとき(行数がエクセルの最大行数と等しいならば) If .Rows.Count = Rows.Count Then 'シート全体が選択されている場合(列数もエクセルの最大列数と等しいならば) If .Columns.Count = Columns.Count Then response = MsgBox("処理に時間が掛かりますが、良いですか?", vbYesNo, "shrinkSelectionRow") If response = vbNo Then Exit Sub End If maxRowCount = 1 For i = 1 To .Columns.Count If .Cells(Rows.Count, i).End(xlUp).Row > maxRowCount Then maxRowCount = .Cells(Rows.Count, i).End(xlUp).Row End If Next minRowCount = Rows.Count For i = 1 To .Columns.Count If .Cells(1, i).Value <> "" Then minRowCount = 1 Exit For End If If .Cells(1, i).End(xlDown).Row < minRowCount Then minRowCount = .Cells(1, i).End(xlDown).Row End If Next Range(.Rows(minRowCount), .Rows(maxRowCount)).Select End If End With End Sub Sub shrinkSelectionColumn() Dim maxColumnCount As Long, minColumnCount As Long With Selection '行が選択されているとき(列数がエクセルの最大列数と等しいならば) If .Columns.Count = Columns.Count Then 'シート全体が選択されているとき(行数もエクセルの最大行数と等しいならば) If .Rows.Count = Rows.Count Then response = MsgBox("処理に時間が掛かりますが、良いですか?", vbYesNo, "shrinkSelectionColumn") If response = vbNo Then Exit Sub End If maxColumnCount = 1 For i = 1 To .Rows.Count If .Cells(i, Columns.Count).End(xlToLeft).Column > maxColumnCount Then maxColumnCount = .Cells(i, Columns.Count).End(xlToLeft).Column End If Next minColumnCount = Columns.Count For i = 1 To .Rows.Count If .Cells(i, 1).Value <> "" Then minColumnCount = 1 Exit For End If If .Cells(i, 1).End(xlToRight).Column < minColumnCount Then minColumnCount = .Cells(i, 1).End(xlToRight).Column End If Next Range(.Columns(minColumnCount), .Columns(maxColumnCount)).Select End If End With End Sub
No comments :
Post a Comment