Excel2007でVBAを用いて名簿を作成したいのですが、うまくいき

質問

Excel2007でVBAを用いて名簿を作成したいのですが、うまくいきません。
どうかお力を貸していただけませんでしょうか。

【シート名】
シート1：名簿データ入力
シート2：名簿一覧

【質問内容】
シート1に入力した内容を、シート2に転記したいと思っています。

シート1には下記の項目を入力します。
C2　氏名
E2　フリガナ
G2　敬称
I2　性別
C3　分類1
E3　分類2
C5　会社名
E5　部署名1
G5　部署名2
I5　役職名
C6　〒
E6　住所1
G6　住所2
C7　電話番号
E7　ファックス
G7　携帯番号
I7　Eメール
C9　摘要

・上記の入力完了後にボタンを押すことで、シート2のB2～S2に転記（並びは、上記を上から順番）され、入力したものは未入力状態に戻るようにする。
・2件目以降は次の行に転記されていく（1件目B2～S2、2件目B3～S3、3件目B4～S4・・・・）
※削除により、行がとびとびに入力されている場合は空いている行に入るようにする

以上のことを可能にするコードをお教え願えませんでしょうか。
加えて、シート2に転記された一覧を、テーブルとして設定し、並べ替え等は行えるのでしょうか？
よろしくお願いいたします。

回答No.2

noname#144013 · ベストアンサー

こんにちは。

サンプルマクロを作成してみました。
宜しければ、試してみて下さい。
※フォームは、使用していません。
※目的のものと違っていた場合は、すみません。

マクロ実装の前に、「名簿データ入力」シートに、マクロ起動用の「ボタン」を作成
し、そのボタンのクリック時のイベントプロシージャを、シートモジュールに作成し
て下さい。

※以下は、Excel2000でのワークシートに「ボタン」を貼り付ける手順と、そのボタン
　に対するクリック時のイベントプロシージャを作成する手順の一例です。
　他のバージョンのExcelで操作が異なる場合は、対応する同様な操作に置き換
　えて下さい。

１）メニュー　「表示」→「ツールバー」→「コントロールツールボックス」で表示
　されたダイアログボックス上の「ボタン」を、シートに貼り付けて下さい。
　注）「フォーム」ダイアログボックス上のボタンではありません。

２）ボタンを貼り付けたら（デザインモードがONの状態で）、ボタンの「プロパティ」
　設定により、ボタンの名前（Caption）などの設定を行って下さい。

３）次に（そのままデザインモードがONの状態で）、ボタンをダブルクリックして
　下さい。
　VBE（Visual Basic Editor）が起動し、対象のワークシートのシートモジュール
　に、ボタンクリック時のイベントプロシージャ（中身が書かれていない雛型）が
　作成されると思います。

４）上記３）で作成された、イベントプロシージャ（以下のような名前の関数）
　　　　Private Sub CommandButton1_Click()

　　　　End Sub
　　↑この中に、下記のマクロを貼り付けて下さい。
　注）先頭のプロシージャ名の部分と、最後の End Sub の重複した行は、
　　　どちらか一方を削除して下さい。

■サンプルマクロ
注１）このマクロは、「名簿データ入力」シートのシートモジュール
　　　（※標準モジュールではなく）に実装するものです。
注２）インデント等のため、全角スペースを入れています。

/////↓ここから///////////////
'== [名簿登録]ボタンクリック時の処理 ==
Private Sub CommandButton1_Click()

　　Dim sh1 As Worksheet　　　　'データ入力シートのWorksheet取得用
　　Dim sh2 As Worksheet　　　　'名簿一覧シートのWorksheet取得用
　　Dim rgSrce As Range　　　　 'データ入力シートのセルのRange取得用
　　Dim rgDest As Range　　　　 '名簿一覧シートのセルのRange取得用
　　Dim vSrcAdrs As Variant　　 '入力項目のセルアドレスの配列
　　Dim vSrcName As Variant　　 '入力項目の項目名の配列
　　Dim vSrcFlag As Variant　　 '入力項目の必須項目定義フラグの配列
　　Dim vSrcData() As Variant　 '入力データ取得用の配列
　　Dim nErr As Integer　　　　 'エラー情報
　　Dim i As Long　　　　　　　 'カウンタ変数
　　Dim nDatNum As Long　　　　 '入力データの項目数
　　Dim nRow As Long　　　　　　'行位置の取得用
　　Dim nRowMax As Long　　　　 '行位置の最大値
　　Dim nTblNo As Long　　　　　'名簿一覧のデータ登録番号
　　Dim nTblNoMax As Long　　　 '名簿一覧の最大登録数
　　Dim sMsg As String　　　　　'メッセージ文字列

　　'入力項目のセルアドレスの配列を作成
　　vSrcAdrs = Array("C2", "E2", "G2", "I2", "C3", _
　　　　"E3", "C5", "E5", "G5", "I5", _
　　　　"C6", "E6", "G6", "C7", "E7", _
　　　　"G7", "I7", "C9")

　　'入力項目の項目名の配列を作成（※今回は未使用）
　　vSrcName = Array("氏名", "フリガナ", "敬称", "性別", "分類1", _
　　　　"分類2", "会社名", "部署名1", "部署名2", "役職名", _
　　　　"〒", "住所1", "住所2", "電話番号", "ファックス", _
　　　　"携帯番号", "Eメール", "摘要")

　　'入力項目の必須項目を定義したフラグ配列を作成
　　'※ =1：必須データ、=0：任意データ
　　vSrcFlag = Array(1, 1, 0, 1, 1, _
　　　　　　　　　　 0, 0, 0, 0, 0, _
　　　　　　　　　　 0, 0, 0, 0, 0, _
　　　　　　　　　　 0, 0, 0)

　　'入力データ取得用の作業用配列を初期化
　　nDatNum = UBound(vSrcAdrs) + 1　'入力データの項目数を取得
　　ReDim vSrcData(nDatNum - 1)　　 '作業用配列のリサイズ
　　For i = 0 To nDatNum - 1
　　　　vSrcData(i) = ""　　　　　　'データを初期化
　　Next i

　　'データ入力シートのWorksheetオブジェクト取得
　　Set sh1 = Sheets("名簿データ入力")

　　'データ入力シートの入力データを作業用配列に取得
　　nErr = 0
　　On Error Resume Next
　　For i = 0 To nDatNum - 1
　　　　If vSrcAdrs(i) <> "" Then
　　　　　　Set rgSrce = sh1.Range(vSrcAdrs(i))　'入力データのセルを取得
　　　　　　If Trim(rgSrce.Text) = "" And vSrcFlag(i) <> 0 Then
　　　　　　　　nErr = 1　'必須項目が未入力ならエラーとする
　　　　　　　　Exit For　'ここでループを抜ける
　　　　　　End If
　　　　　　vSrcData(i) = rgSrce.Value　'入力データを作業用配列に保存
　　　　End If
　　Next i
　　On Error GoTo 0
　　Set rgSrce = Nothing

　　'必須項目が未入力だった時のメッセージ表示
　　If nErr = 1 Then
　　　　sMsg = "必須項目にデータが入力されていません。"
　　　　MsgBox sMsg, vbOKOnly Or vbExclamation
　　　　Set sh1 = Nothing
　　　　Exit Sub　　'ここで処理を抜ける
　　End If

　　'名簿一覧シートのWorksheetオブジェクト取得
　　Set sh2 = Sheets("名簿一覧")

　　'名簿一覧シートのA列の登録番号を再設定
　　'※ユーザー操作で行削除された場合、登録番号に抜けが出るため、
　　'　その防止策として登録番号を先頭から再設定する
　　Application.ScreenUpdating = False
　　nRowMax = sh2.Range("B" & sh2.Rows.Count).End(xlUp).Row
　　If nRowMax < 2 Then nRowMax = 2
　　sh2.Range("A:A").ClearContents
　　sh2.Range("A:A").NumberFormatLocal = "G/標準"
　　sh2.Range("A1").Value = "No."
　　sh2.Range("A2:A" & nRowMax).FormulaLocal = "=ROW(A1)"
　　sh2.Range("A2:A" & nRowMax).Value = sh2.Range("A2:A" & nRowMax).Value
　　Application.ScreenUpdating = True

　　'名簿一覧シートのデータ未登録の行位置を検索
　　'※B列セルで最初に見つかった空白セルの行位置を取得する
　　nRowMax = sh2.Rows.Count　　　　'シートの総行数を取得
　　nTblNoMax = sh2.Rows.Count - 1　'名簿一覧の最大登録数を計算
　　nRow = 0　　　　　　　　　　　　'行位置の初期化
　　nTblNo = 0　　　　　　　　　　　'登録番号の初期化
　　For Each rgDest In sh2.Range("B2:B" & nRowMax)
　　　　nTblNo = nTblNo + 1　　　　 '登録番号を＋１
　　　　'データ未登録のチェック
　　　　If Trim(rgDest.Text) = "" Then
　　　　　　nRow = rgDest.Row　　　 '行位置を取得
　　　　　　Exit For　　　　　　　　'ここでループを抜ける
　　　　End If
　　Next

　　'名簿一覧シートに入力データを登録
　　'※上の処理で見つけた行に入力データを登録する
　　If nRow > 0 And (Not rgDest Is Nothing) Then
　　　　'A列セルに登録番号をセット
　　　　rgDest.Offset(0, -1).Value = nTblNo
　　　　'B列以降に項目数分の入力データを登録
　　　　For i = 0 To nDatNum - 1
　　　　　　rgDest.Offset(0, i).Value = vSrcData(i)
　　　　Next i
　　　　'データ入力シートの入力データをクリアする
　　　　On Error Resume Next
　　　　For i = 0 To nDatNum - 1
　　　　　　If vSrcAdrs(i) <> "" Then
　　　　　　　　sh1.Range(vSrcAdrs(i)).Value = ""　'セルの値をクリア
　　　　　　End If
　　　　Next i
　　　　On Error GoTo 0
　　End If

　　'各オブジェクトの解放
　　Set sh1 = Nothing
　　Set sh2 = Nothing
　　Set rgSrce = Nothing
　　Set rgDest = Nothing

　　'データ登録ができなかった時のメッセージ表示
　　If nRow = 0 And nTblNo >= nTblNoMax Then
　　　　sMsg = "データが登録できません。" + vbLf + vbLf
　　　　sMsg = sMsg & "名簿一覧の登録数がいっぱいの可能性があります。" + vbLf
　　　　sMsg = sMsg & "名簿一覧のデータ削除などの処置を行って下さい。"
　　　　MsgBox sMsg, vbOKOnly Or vbExclamation
　　End If

End Sub
/////↑ここまで///////////////

注）上記マクロ中の入力項目の「必須項目」を定義するフラグ配列 vSrcFlag の
　　フラグON/OFFの設定は、ご都合に合わせて変更して下さい。

※添付画像は、上記マクロを実装したExcelブックのシート画面をキャプチャした
　ものです。（見辛かったらすみません）

あと、以下の件ですが、

＞ 加えて、シート2に転記された一覧を、テーブルとして設定し、
＞ 並べ替え等は行えるのでしょうか？

これは、Excelの「並べ替え」の機能（メニュー操作　「データ」→「並べ替え」）で、
可能だと思います。

以上です。参考になれば幸いです。

お礼

FarEyesさん、ありがとうございます。
私の思い描いていた通りのものが出来上がり感激しています。
説明もとても丁寧ですぐに理解することができ、勉強になりました。
もっと勉強をして、いずれ私も回答できる側に立ちたいと思いました。
本当にありがとうございました！

回答No.1

hana-hana3

データフォーム機能ではだめでしょうか？

http://121ware.com/qasearch/1007/app/servlet/qadoc?QID=009376
http://enjoyalmightypc.blog38.fc2.com/blog-entry-55.html

お礼

このような便利な機能もあるのですね、とても勉強になりました。

ただ、今回私が求めているものとは多少異なってしまいます。
私の質問が不十分であったため、少し補足をさせていただきます。

今回は複数の者が打ち込む入力フォームとしたいので、人によってバラツキがでないように
入力するセルに入力規則のドロップダウンリストを設けようと考えています。

言葉足らずで申し訳ございませんでした。
データフォームは素晴らしい機能ですね。また別の機会で使用したいと思います。
ご回答ありがとうございました。