category name » page title date

行・列へのジャンプ

アンケート調査の調査票などは、まずはワークシートに原票をつくって、集計したりグラフ化したりすることになりますが、１００問の設問に２０００人が回答・・・などというスケールになると、原票の管理だけで大変な作業になります。
たとえば、表頭に設問、表側に回答者という２次元の原票があって、ある人のある設問の回答がちょっとおかしい、などという時に、その欄をスクロールして探すだけでも手間です。そこで、表頭の記号か番号と表側の回答者番号を指定すれば、一気に該当欄を表示する、というプログラムを作ってみました。

実際には、原票の入力を二人が別々に独立して行い、できあがった二つのファイルを照合して入力ミスを発見する、という仕組みの一環として作ったものの一部です。本体のプログラムは「どこそこに齟齬があるよ」と教えてくれるのですが、その欄にたどりつくのが苦労だったので、助け舟として追加したものです。

まず、ワークシートの構成はこういう風にしました。
青く塗ったセルが表頭/表側で、A1、A2などが表頭の検索対象、１００、１０１などが表側の検索対象となる部分、C列から右、４行から下がデータ部分です。
ウィンドウ枠は、C4のセルで固定してあります。
左上の黄色い箱に謎の記号（右と下の矢印のつもり）が描かれている画像は、該当欄を検索して表示するためのユーザーフォームを表示するためのスイッチです。この画像には、マクロ "OpenJumpCellForm" を登録しておきます。

ユーザーフォームは、こういうのを用意しました。
そのプログラムは下記のとおり。黄色いコマンドボタンで、それぞれ表頭／表側を検索・表示します。
ふたつのコマンドボタンのクリックイベントだけに対応していればいいのですが、ちょっと親切に最後に検索した内容を記憶しておくようにしました。

ユーザーフォーム JumpCellForm

'--- コマンドボタンによる JumpCell() の起動
Private Sub HeadCommandButton_Click()
      JumpCell True, HeadTextBox.text
End Sub
Private Sub SideCommandButton_Click()
      JumpCell False, SideTextBox.text
End Sub
'--- フォームの開閉時に最後の検索語を取得／保存
Private Sub UserForm_Activate()
      HeadTextBox.text = LastHeadText
      SideTextBox.text = LastSideText
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      LastHeadText = HeadTextBox.text
      LastSideText = SideTextBox.text
End Sub

標準モジュールには、OpenJumpCellForm() と JumpCell() のふたつのパブリックなマクロを記載します。いずれもそんなに複雑ではありませんので、コードをご覧ください。

標準モジュール JumpCell(), OpenJumpCellForm()

'--- 見出しの行／列と先頭列番号／先頭行番号を定義
Private Const headRow = 2
Private Const headStartColumn = 3
Private Const sideColumn = 2
Private Const sideStartRow = 4
'--- 最後の検索語を記憶
Public LastHeadText As String
Public LastSideText As String

'--- ワークシートのスイッチで実行するマクロ
Public Sub OpenJumpCellForm()
      JumpCellForm.Show vbModeless
End Sub

'--- フォームのスイッチで実行するマクロ
Public Sub JumpCell(headOrSide As Boolean, searchText As String)
      ButtonChick
      Select Case headOrSide
            Case True: jumpColumn searchText
            Case False: jumpRow searchText
      End Select
End Sub
'--- 列（表頭）の検索
Private Sub jumpColumn(searchText As String)
Dim searchRange As Range
Dim targetCell As Range
      '検索するセル範囲を設定
      Set searchRange = Range(Cells(headRow, headStartColumn), Cells(headRow, Cells.Columns.count))
      '検索した結果で該当セルを選択
      Set targetCell = findCell(searchText, searchRange)
      If Not targetCell Is Nothing Then _
            ActiveSheet.Cells(Selection.row, targetCell.column).Select
End Sub
'--- 行（表側）の検索
Private Sub jumpRow(searchText As String)
Dim searchRange As Range
Dim targetCell As Range
      '検索するセル範囲を設定
      Set searchRange = Range(Cells(sideStartRow, sideColumn), Cells(Cells.Rows.count, sideColumn))
      '検索した結果で該当セルを選択
      Set targetCell = findCell(searchText, searchRange)
      If Not targetCell Is Nothing Then _
            ActiveSheet.Cells(targetCell.row, Selection.column).Select
End Sub
'--- 検索する共通関数
Private Function findCell(searchText As String, searchRange As Range) As Range
      If Len(searchText) = 0 Then Exit Function
      Set findCell = searchRange.Find(what:=searchText, LookIn:=xlValues, lookat:=xlWhole)
      If findCell Is Nothing Then _
            MsgBox searchText & vbCrLf & "が見つかりません。", vbOKOnly, "ジャンプしようとしたけど"
End Function

このユーザーフォーム JumpCellForm と上のふたつのパブリックなマクロのはいった標準モジュールを追加し、原票となるワークシートの隅に OpenJumpCellForm() を起動するスイッチを貼り付ければ、これは、汎用に使えます。ただし、その際には、標準モジュール内の最初の４行にある定数を原票の仕様にあわせて変更してください。