category name » page title date

表の対象範囲を選択

グラフを描いたり、統計計算をさせたり、いろいろな処理を行う場合に、その都度、対象欄として表の中の特定の範囲を選択し直してやらせたい、ということがよくあります。
ここでは、特定のセルをダブルクリックして起点を指定し、その列の有効な行までの範囲を得る、というマクロを作ってみました。

このミソは２つ。ひとつは、指定された範囲の情報がビジュアルに表示されるとともに保存されること。
たとえば、次の図のように、６行目F列をダブルクリックすると、そこから下の欄が指定されたことになり、その範囲の塗り色が（ここでは青く）変わることで結果が目に見えること。さらにその情報が "TopRow","EndRow","Column" という名前のついたセルに保存されること（この保存先はわかりやすいように表と同じワークシートに配置していますが、もちろん別の作業用ワークシートに配置したほうがエレガントな場合もあります）。

もうひとつのミソは、対象欄を選択することと、表の中を編集することとはフェーズが異なるので、ダブルクリックの機能をそれぞれ分けなくてはいけないこと。ここでは、「対象欄の指定」ボタンをクリックすると選択モードになり、そのことを告げるユーザーフォームが表示され、その完了ボタンを押すことで編集モードに戻る、という仕掛けにしました。
このモードは、InClassFlag というフラグで切り替えています。

ユーザーフォームは、こんな感じの簡単なもの。「今は選択モードだよ」と告げるだけのものなので、その文章を表示する InstructionLabel と終了するための「完了」ボタン OKCommandButton が配置されているだけです。この完了ボタンか「X」を押してフォームを閉じるタイミングで、InClassFlag が降ろされて、編集モードに戻ります。

ユーザーフォーム InstructionForm

Private Sub OKCommandButton_Click()
      Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      InClassFlag = False
End Sub

そこで問題なのは、このユーザーフォーム InstructionForm を表示している間に、ワークシートのダブルクリックを受け付けなくてはならないこと。InstructionForm.Show vbModal で表示すると、このフォームを閉じるまでワークシートにアクセスすることができません。vbModeless で表示すると、表示している間にアクセスができますが、マクロの実行はどんどん次に進んでしまいます。
それをうまく回避する方法はいくつかありそうですが、ここでは標準モジュールのサブルーチン instructionMessage にあるように、InClassFlag が降りるまで表示を続け、その間にワークシートのイベントを受け付けるようにしました。

基本的な構成は、そんなに複雑ではありません。ワークシートの BeforeDoubleClick イベントを受けつけて、そのイベントの発生したセルのオブジェクトを標準モジュールの ReceiveTopCell に渡し、そこで記録やセルの色塗りを行う、というものです。

ワークシート

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
      If Not InClassFlag Then Exit Sub
      target.Offset(1, 0).Select
      ReceiveTopCell target
End Sub

標準モジュール

'----- 指定作業中を示すフラグ（授業中）
Public InClassFlag As Boolean
'----- 指定されたレンジの塗りつぶし色
Private Const targetRangeColorIndex = 34
'----- 指定レンジを記録するセルの名前
Private Const topRowCellName = "TopRow"
Private Const endRowCellName = "EndRow"
Private Const targetColumnCellName = "Column"
'----- 指定開始ボタンで呼び出すマクロ
Public Sub StartSelectTopCell()
      InClassFlag = True
      instructionMessage "対象とするセル範囲の" & vbCrLf & _
            "先頭をダブルクリックしてください。"
End Sub
'----- セルのダブルクリックで呼び出すマクロ
Public Sub ReceiveTopCell(target)
      If Not InClassFlag Then Exit Sub
      limitLocation
      clearRangeColor
      topRow = target.row
      targetColumn = target.column
      limitLocation
      paintRangeColor targetRangeColorIndex
End Sub
'----- 指定する範囲を限定、endRow を計算
Private Sub limitLocation()
      If targetColumn < 4 Then targetColumn = 4
      If topRow < 4 Then topRow = 4
      With ActiveSheet
            endRow = .Cells(.Rows.count, targetColumn).End(xlUp).row
      End With
End Sub
'----- 指定されたレンジの塗りつぶし色を設定／消去
Private Sub paintRangeColor(cIndex)
      With ActiveSheet
            .Range(.Cells(topRow, targetColumn), .Cells(endRow, targetColumn)). _
                  Interior.ColorIndex = cIndex
      End With
End Sub
Private Sub clearRangeColor()
      paintRangeColor 0
End Sub
'----- 入力指示メッセージ
'vbModeless ながら、閉じるまで次に移動しない
Private Sub instructionMessage(msg)
      With InstructionForm
            .InstructionLabel.Caption = msg
            .Show vbModeless
      End With
      Do While InClassFlag: DoEvents: Loop
End Sub
'----- 現在の指定レンジを取得／記録
'ここでは、仮に ActiveSheet に記録欄を確保している
Private Property Get topRow()
      topRow = ActiveSheet.Range(topRowCellName).value
End Property
Private Property Let topRow(row)
      ActiveSheet.Range(topRowCellName).value = row
End Property
Private Property Get endRow()
      endRow = ActiveSheet.Range(endRowCellName).value
End Property
Private Property Let endRow(row)
      ActiveSheet.Range(endRowCellName).value = row
End Property
Private Property Get targetColumn()
      targetColumn = ActiveSheet.Range(targetColumnCellName).value
End Property
Private Property Let targetColumn(column)
      ActiveSheet.Range(targetColumnCellName).value = column
End Property