アンケートフォームの結果から、メールアドレスリストを作ろう
公演でアンケートを取って、メールアドレスを収集して、次の公演の時にアドレスリストを使うということは、多くの劇団でやっている作業だと思います。
アンケートフォームからCSVをダウンロードしたらこうなっていたとします。
このCSVをダウンロードする
このアンケートの表を使って、氏名とメールアドレスだけのリストを作ってみましょう。
ただし、メールアドレスリストには、メルマガの列が「はい」になっている人だけをリストに入れたいということにします。
また、同じメールは2つ要らないので、一人につき一つのメールアドレスがあれば事足ります。
では、一つずつマクロを書いていきましょう。
シートをコピー
大事なフォームの結果が失われてしまわないように、まずはシートをコピーします。
開発→Visual Basic
挿入→標準モジュール として、
Sub address_seiri()
End Subとしましょう。
続いてシートをコピーします。
なお、シートの複製（コピー）のやり方はその14でやりましたので、ご参照ください。
その時は、シートの名前を指定していましたが、今回は今いるシートということでやってみましょう。
今いるシートをActiveSheetと呼ぶので、
今いるシート（ActiveSheet）の後ろに、新しいシートを作るには、
ActiveSheet.Copy after:=ActiveSheetとすれば良さそうです。
もちろん、シートの名前（address_seiri）を指定して、
Sheets("address_seiri").Copy after:=Sheets("address_seiri")としても大丈夫です。
続いて、シートの名前を付けておきましょう。
シートのコピーを行った直後は、【コピー後のシート】がアクティブになるので、resultという名前を付けるには
ActiveSheet.Name = "result"と書きましょう。
これを実行すると
resultというシート名を付けることができました。
不要な行を削除
では次に、不要な行を削除していきましょう。
今回「不要な行」は、メルマガの列で「いいえ」と答えている人です。
つまりメルマガは要らないとアンケートで答えた人に、メールを送るわけにいかないので削除しようということですね。
このことをマクロちゃんに伝えるためにはどうすればよいでしょうか？
Ifを使えば良さそうですね。
・・・もし「いいえ」だったらその行を削除する
というのをマクロで表現していきましょう。
例としてD3の「いいえ」を狙ってみましょう。
D3はCellsで表現するとCells(3, 4)で、
3行目はRows(3)なので、
If Cells(3, 4) = "いいえ" Then
Rows(3).Delete
End Ifとすれば良いですね。
※Ifについてはその7、行の削除についてはその15をご参照ください。
この時、コピーしてできたresultシートを一度削除してから、マクロを実行してください。
そのまま実行するとエラーが出るはずです。
3行目の「いいえ」の行を消すことができました。
良さそうなので、2行目から8行目まで繰り返しましょう。
繰り返すにはおなじみのFor Nextを使います。
今書いたIf文をFor Nextで挟みます。
さっきは3だったところが変化する部分なので、iで置き換えて、i = 2 To 8 としてみましょう。
これを実行すると
残念ながら「いいえ」が残ってしまいました・・・。
何故でしょう。
実は、「いいえ」を見つけたら行を削除ということ繰り返しているため「いいえ」が連続していると、その行を見逃してしまうということなんですね。盲点でした・・・。
これを解決するために簡単な方法としては、上から順に作業するのではなくて、下から順に作業するというやり方が良いそうです。
i = 8 To 2 に変えて、さらに Step -1 というのを書き足してください。
これはStep -1というので、1ずつ数字を下げていくという命令です。
なので、8, 7, 6, ・・・, 3, 2という順で実行されるということですね。
これを実行すると
うまく「いいえ」のあった行を削除できました！
重複を削除
次に、よく見ると吉宗さんのアドレスが重複しています。
劇団のファンほど、何度も来て、毎回アンケートを書いてくださいます。ただアドレスは重複してもしょうがないので、重複しているアドレスは削除しましょう。
エクセルにはもともと「重複の削除」ができる RemoveDuplicates というコマンドがあるのでこれを使います。
重複を確認したいのは、メールアドレスが書いてあるC列（3列目）なので
Cells.RemoveDuplicates (3)と書きます。
Cellsは、このシート全体 という意味です。
このコードを追加して実行すると、
メールアドレスの重複を削除できました！
不要な列を削除
最後に不要な列を削除していきましょう。
氏名とアドレスだけ残したいので、B列、D～F列は削除したいですね。
先程の反省を生かして、D～F列を先に削除しましょう。
Columns("D:F").Delete
Columns("B").Deleteと書きます。
複数の列を削除するときは、こんな風に書きます。複数行の削除の時は番号だったんですが、列はアルファベットじゃないとうまく行かないようですのでご注意ください。
これを実行すると
うまく名前とメールアドレスだけにすることができました。
最終的なマクロの内容はこんな感じです。
アンケートフォームの結果はカンパニーによって異なると思うので、ご自分の環境でメールアドレスを整理するシステムを作ってみてください。
今回の最終的なコード
Sub address_seiri()
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "result"
For i = 8 To 2 Step -1
If Cells(i, 4) = "いいえ" Then
Rows(i).Delete
End If
Next
Cells.RemoveDuplicates (3)
Columns("D:F").Delete
Columns("B").Delete
End Sub宿題-16
演出家はとても繊細な人で、「僕は酷いアンケートは読みたくない！」と言っているとします。
それが彼のためになるかどうかはさて置き、評価が6以上のものだけに絞り、「アンケート」「評価」だけを読めるように整理してください。
解説
まず、データが失われないようにシートをコピーしておきます。名前は「評価を整理」シートにしましょう。
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "評価を整理"では、評価が6未満のものを削除しましょう。
7行目で実験してみましょう。
If Cells(7, 6) < 6 Then
Rows(7).Delete
End If
これで評価が1だった7行目がうまく削除できたので、これをFor Nextで繰り返します。（Step -1と指定して、最終行から2行目までさかのぼるように繰り返します。）
最終行をlastRowとすると、lastRow = Cells(Rows.Count, 1).End(xlUp).Row でしたよね。
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, 6) < 6 Then
Rows(i).Delete
End If
Nextあとは、A列からD列までを削除すればいいので、
Columns("A:D").Deleteとすれば完成です。
最終的なコードはこちらです。
Sub hw16_hyokaSeiri()
'シートをコピーして名前を付ける
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = "評価を整理"
'最終行を取得
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'最終行から2行目まで繰り返す
For i = lastRow To 2 Step -1
'もし評価が6未満だったらその行を削除
If Cells(i, 6) エクセルマクロ(EXCEL VBA) その17 抽選システムを作る(Rnd)
（文：森脇孝／エントレ）