みなさん、こんにちはケンケンです。
今回は、ExcelVBAを使ってアンケート結果をシートに書き出す方法をご紹介します。
フォームのオプションボタンを工夫して使っていくので参考にしてください。
それでは、以下ご覧ください。
アンケートをフォームからエクセルシートへ転記する方法
まず今回は、ユーザーフォームが使えることが前提として話を進めていきますので、
わからない方は以下の記事をご覧いただいてからのほうが理解が速いと思います。
みなさん、こんにちはケンケンです。 今回は、ユーザーフォームの作り方をご紹介します。 実務でよく耳にするのは「管理データを作っているけど、横に長い表にたくさんの項目を入力するのが面倒！」といった声です。 […]
フォームの作り方だけ簡単に説明しますと、VBE（エディター）を起動させて
「挿入」から「ユーザーフォーム」を選択します。
完成図
上図のように、アンケート形式で横に長い表があります。
よく見かけるものではないでしょうか。これをひとつひとつ横スクロールで埋めていくと
手間がかかるし記載ミスが起こりやすいです。
そこで、フォームを使って改善していくのですが、今回は以下のようにフォームを作りました。
各質問に対し１～５まで選択肢があり、質問が３０個あるものを想定しています。
これなら、シートを横にスクロールさせて入力するよりだいぶ手間が省けそうです。
このフォームに
名前・日付を入力し、
質問の回答を選択して、
結果転記ボタンをクリックすると、
先ほどのエクセルシートに転記できる仕組みとなっています。
オプションボタンの特性
まず、今回使うオプションボタンの特性からお話しします。
オプションボタンは、複数配置してそのうちのひとつが選択されると
「True」になりそれ以外が「False」になる特性を持っています。
例えば、以下のように３つオプションボタンが並んでいたとします。
ボタンのオブジェクト名は上から
- OptionButton1
- OptionButton2
- OptionButton3
となっています。
この状態でりんごをクリックしたら、りんご（OptionButton1）の値がTrueになります。
そして、みかん（OptionButton2）とパイナップル（OptionButton3）はFalseになります。
では、りんごが選択されている状態からみかんを選択するとどうなるでしょうか。
みかん（OptionButton2）がTrueになってさっきまでTrueだったりんご（OptionButton1）と
パイナップル（OptionButton3）がFalseになります。
コードで確認することもできるので、一例をお見せします。
フォーム上に作ったコマンドボタンをダブルクリックしてプロシージャを生成します。
そのプロシージャに次のようにコードを書いてください。
▶オプションボタンのTrue・False判定
|
1 |
Private Sub CommandButton1_Click()
Range("B1").Value = OptionButton1.Value
Range("B2").Value = OptionButton2.Value
Range("B3").Value = OptionButton3.Value
End Sub |
True・Falseの判定はvalueプロパティでできます。
判定結果をエクセルシートに書き出せますので試してみてください。
Tagプロパティについて
VBAにはTagプロパティというおもしろいものがあります。
特に、何か意味があるものではありません。
強いて言うなら、作成者が意味を持たせることができるプロパティといえるかもしれません。
例えば、フォーム上にある複数のオブジェクトをひとつの固まりとして考えたいときに、
Tagプロパティを使ってそれぞれのオブジェクトに名前を付けておきます。
すると、その名前を付けたオブジェクトだけでループを回せるようになったりします。
知らない人が多いですが、知っていると何かと便利なのでこの際覚えてしまいましょう。
今回は、オプションボタンを使おうとすると不都合があることはお分かりいただけますか。
そうです。
このままだと、ひとつの質問に答えたらほかの質問に答えられません。
オプションボタンは、ひとつしかTrueにできないのでしたね。
しかし、Tagプロパティでオプションボタンを複数のグループに分けてしまうと、
複数選択が可能になるのです。
以下で具体的に見ていきましょう。
ForEachですべてのオブジェクトをループできる
オブジェクトをすべてループさせて処理をするためには、ForEachを使います。
簡単なフォームを作ってコードを書いてみます。
５つのコマンドボタンが配置されています。
一番下のボタンは、実行ボタンです。
上４つのボタンのうち、１つめと４つめのボタンのTagプロパティを「タグ」にしておきます。
この状態で、以下のようにコードを書いてください。
▶シート内にあるオブジェクトをループさせるコード
|
1 |
Private Sub CommandButton5_Click()
Dim obj As Object
For Each obj In UserForm2.Controls
If obj.Tag = "タグ" Then
obj.Caption = "こまんど"
End If
Next
End Sub |
実行ボタンをダブルクリックして生成されたプロシージャに上記のようにコードを書きましょう。
まず、オブジェクト型の変数を宣言します。
その後、ForEach文でフォーム内にあるすべてのオブジェクトをループさせます。
UserForm2.ControlsのUserForm2部分はご自分が作成したフォーム名を記述してください。
If以下の条件分岐は、オブジェクトのTagプロパティ名が「タグ」だったら、
キャプションを「こまんど」にしますよ、ということです。
ここで実行結果を見てみましょう。
Tagプロパティを変更していたボタンだけキャプションが変化しました。
TagプロパティとForEach文を組み合わせるとこういったことができます。
質問１だけループさせる
それでは、アンケートフォームに戻っていただいて、オプションボタンのTag名を変更してグループ分けしてみましょう。
上図赤枠のなかだけTag名を質問１に変更してみましょう。
ちなみに、Tagプロパティの変更はプロパティウィンドウからできます。
Tagプロパティの変更ができたら、一度フォームを起動させてオプションボタンが複数選択できるか確かめてみましょう。
うまくいっているようです。
それでは、さらに、TabIndexを下図のように変更しておいてください。ちょっと変わった手法を使います。
TabIndexもプロパティウィンドウから変更できます。
さて、ここまで準備ができたらコードを書いていきます。
▶オプションボタンがTrueのときシートに書き出す
|
1 |
Private Sub CommandButton1_Click()
Dim obj As Object
For Each obj In frmmain.Controls
If obj.Tag = "質問1" Then
If obj.Value = True Then
Cells(2, 4).Value = obj.TabIndex
End If
End If
Next
End Sub |
コードの解説
変数の宣言とForEachの説明は先ほどしたので割愛します。
▶条件分岐ひとつ目
If obj.Tag = “質問1” Then～End If
もし、オブジェクトのTagプロパティが「質問１」だったら～をする、という条件式を表しています。
▶条件分岐ふたつ目
If obj.Value = True Then～End If
もし、オブジェクトの値がTrueだったら～をするという条件式です。
ひとつ目の条件をパスしたものはすべてオプションボタンのはずなので、
ここでTrueの判定がでる場合というのは、オプションボタンが選択されている状態であると解釈できますね。
▶選択肢の番号をシートに書き出す
Cells(2, 4).Value = obj.TabIndex
先ほどTabIndexを１から５に変更しました。
これは何をしていたかと言うと選択肢の番号と合わせていたのです。
そして、もう一度コードを見てください。
オブジェクトのTabIndexをシートの２行４列目に記載しています。
これで、実質、選択肢番号をシートに書き込むことができます。
では、コードを実行してみましょう。
質問２～１０までループさせる
質問１の処理がうまくいけば後は簡単です。
質問１と同様の処理をすれば良いのです。
ちょっと面倒ですが、質問２～１０までのオプションボタンのTagとTabIndexを変更しておきましょう。
下準備ができたらコードを書きます。
▶質問２～１０までのコード
|
1 |
Private Sub CommandButton1_Click()
Dim obj As Object
For Each obj In frmmain.Controls
If obj.Tag = "質問1" Then
If obj.Value = True Then
Cells(2, 4).Value = obj.TabIndex
End If
End If
If obj.Tag = "質問2" Then
If obj.Value = True Then
Cells(2, 5).Value = obj.TabIndex - 5
End If
End If
If obj.Tag = "質問3" Then
If obj.Value = True Then
Cells(2, 6).Value = obj.TabIndex - 10
End If
End If
If obj.Tag = "質問4" Then
If obj.Value = True Then
Cells(2, 7).Value = obj.TabIndex - 15
End If
End If
If obj.Tag = "質問5" Then
If obj.Value = True Then
Cells(2, 8).Value = obj.TabIndex - 20
End If
End If
If obj.Tag = "質問6" Then
If obj.Value = True Then
Cells(2, 9).Value = obj.TabIndex - 25
End If
End If
If obj.Tag = "質問7" Then
If obj.Value = True Then
Cells(2, 10).Value = obj.TabIndex - 30
End If
End If
If obj.Tag = "質問8" Then
If obj.Value = True Then
Cells(2, 11).Value = obj.TabIndex - 35
End If
End If
If obj.Tag = "質問9" Then
If obj.Value = True Then
Cells(2, 12).Value = obj.TabIndex - 40
End If
End If
If obj.Tag = "質問10" Then
If obj.Value = True Then
Cells(2, 13).Value = obj.TabIndex - 45
End If
End If
Next
End Sub |
単純にIf文を質問１０までつなげたものです。
特に説明することはないのですが、ひとつ注意として、
シートに転記するTabIndexの値は質問を追うごとに増えていきます。
シートに書き出したいのは１～５までの数値なので、転記する値を適宜マイナスしています。
等差数列のようなものですね。
さあ、これで質問１０まで転記できるはずです。
上図のように選択肢とシート転記後の数値が合致していれば成功です。
IDを付与する＆テキストボックスをシートに書き出す
オプションボタンの選択をシートに書き出すことはできましたが、これだけだと不十分です。
このままだと、シートに書き出せるのは２行目だけになってしまいます。
そこで、常に新規の行に追加できるように工夫しましょう。
肝は最終行の取得です。
まずは、最終行を取得して、インデックスをつけるコードを書きます。
▶最終行を取得してIDを振るコード
|
1 |
Dim targetRow
targetRow = Range("A" & Rows.Count).End(xlUp).Row
If targetRow = 1 Then
Range("A2").Value = 1
Else
Range("A" & targetRow + 1).Value = Range("A" & targetRow).Value + 1
End If |
先ほどのプロシージャの先頭に上記コードを追加します。
変数targetRowにシートのA列最終行を格納します。
そして、最終行が１のとき、つまりデータがひとつもないときは、A２セルに１を振ります。
データが入っている時は、上の行の番号に＋１した値をA列最終行＋１行目に振ります。
そして、以下のように質問１～１０までの選択肢をシートに転記した際のセル番地を指定したコードも変更します。
最後にテキストボックスの値をシートに書き出すコードをご紹介します。
▶テキストボックスの値をシートに転記
|
1 |
Range("B" & targetRow + 1).Value = txtName
Range("C" & targetRow + 1).Value = txtDate |
遅ればせながら、氏名と日付のテキストボックスオブジェクト名は「txtName」と「txtDate」にしています。
その値をそれぞれB列とC列に書き込んでいます。
これでコードの記述は終わりです。
実行してちゃんと転記できているか確認しておいてください。
もっとすっきりコードが書けるはず
ここまでご覧いただいた方は思ったはずです。
もっと、「すっきりコードが書けるはず」だと。
そうですよね。今回書いたコードだとIf文内の質問１～１０までのくだりは
ほとんど同じコードの繰り返しです。
ここはすっきりと書き直せるはずです。
書き直せるはずですが、今回はそこはあえてお伝えしません。
理由は２つあります。
- みなさんの力で攻略していただきたい。
- ここまで書ければ実務で充分使える
上記のとおりです。
まず、ひとつ目はみなさんで答えを見つけてほしい、ということです。
答えを出す過程が大事です。
自分の頭で考えてエラーを出しまくって攻略していくうちにだんだんできるようになります。
ここでひとつ挑戦して、さらなるレベルアップを図ってください。
ふたつ目は、ここまでできれば実務ではかなり高い次元にいると言えます。
バリバリのエンジニアを目指すなら不十分かもですが、事務職の仕事を効率化する目的だったら十分なレベルです。
きれいにすっきり書くことを優先するよりも、とりあえず動くものを作って
後からいろいろ試行錯誤する方が結果的に成長も速いと実感しています。
多少長くてくどいコードになっても気にせずガンガン書くことをおススメします。
※グループや部署で共有する場合は、書いたコードを説明できるようにはしておきましょう。
まとめ
いかがでしたか？
アンケート形式のフォームからエクセルシートに転記する方法をご紹介しました。
やり方は、たくさんあると思いますが、今回の方法も面白いのではないでしょうか。
先ほどもお話ししましたが、完成されたコードとは言えません。
みなさんで創意工夫してより良いものにしてみてください。
それが力がつく方法です。
それではまた次回お会いしましょう。
▶今回書いたコード
|
1 |
Private Sub CommandButton1_Click()
Dim obj As Object
Dim targetRow
targetRow = Range("A" & Rows.Count).End(xlUp).Row
If targetRow = 1 Then
Range("A2").Value = 1
Else
Range("A" & targetRow + 1).Value = Range("A" & targetRow).Value + 1
End If
Range("B" & targetRow + 1).Value = txtName
Range("C" & targetRow + 1).Value = txtDate
For Each obj In frmmain.Controls
If obj.Tag = "質問1" Then
If obj.Value = True Then
Cells(targetRow + 1, 4).Value = obj.TabIndex
End If
End If
If obj.Tag = "質問2" Then
If obj.Value = True Then
Cells(targetRow + 1, 5).Value = obj.TabIndex - 5
End If
End If
If obj.Tag = "質問3" Then
If obj.Value = True Then
Cells(targetRow + 1, 6).Value = obj.TabIndex - 10
End If
End If
If obj.Tag = "質問4" Then
If obj.Value = True Then
Cells(targetRow + 1, 7).Value = obj.TabIndex - 15
End If
End If
If obj.Tag = "質問5" Then
If obj.Value = True Then
Cells(targetRow + 1, 8).Value = obj.TabIndex - 20
End If
End If
If obj.Tag = "質問6" Then
If obj.Value = True Then
Cells(targetRow + 1, 9).Value = obj.TabIndex - 25
End If
End If
If obj.Tag = "質問7" Then
If obj.Value = True Then
Cells(targetRow + 1, 10).Value = obj.TabIndex - 30
End If
End If
If obj.Tag = "質問8" Then
If obj.Value = True Then
Cells(targetRow + 1, 11).Value = obj.TabIndex - 35
End If
End If
If obj.Tag = "質問9" Then
If obj.Value = True Then
Cells(targetRow + 1, 12).Value = obj.TabIndex - 40
End If
End If
If obj.Tag = "質問10" Then
If obj.Value = True Then
Cells(targetRow + 1, 13).Value = obj.TabIndex - 45
End If
End If
Next
End Sub |
ユーザーフォームおすすめ記事
【ExcelVBA】ユーザーフォーム活用の基礎【業務改善の強力な武器になります】
【ExcelVBA】ユーザーフォーム活用テクニック編【チェックボックス】
【ExcelVBA】ユーザーフォーム活用テクニック編【イニシャライズとリストボックス】
【ExcelVBA】ユーザーフォーム活用テクニック編【スクロールバーについて】
【ExcelVBA】ユーザーフォーム活用【リストボックスから選択・メッセージボックス活用】
【ExcelVBA】ユーザーフォームを作りこむ【コンボボックスの使い方】
