イベントの出欠を管理してなおかつ、出席者リストをはいてくれるVBA
みんながあまりにもVBAをディスるので、かわいそうになってきました。
「VBAは なかまに なりたそうに こちらをみている!」
てことで、ちょっと必要になったので書きました。
なにができるの?
イベントの出欠を入力した結果をまとめてくれるやつです。
Sheet1のA列に名前、B列に○ or ×を記入した状態で、名前を取得してSheet2にまとめてはきだしてくれるだけです。
はっきりいって、他の言語でもできると思います。ただ、VBAでやってみたかっただけ。
今回は例として、とあるサークルのパーティを題材として…。
実在するところかどうかは触れません。
Sub Shukeisan() ' イベント出欠集計VBA ' Author: cancolle(@wonder_zone) j = 1 'テンプレ ' i = 1 // 属性を取得 ' Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) // 属性 ' j = j + 1 ' For i = 2 To 10 // 各属性の行番号ごとに設定 ' If Worksheets("Sheet1").Cells(i, 2) = "○" Then // セルに○があったら ' Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) // 記帳 ' j = j + 1 // 記帳用変数を1コマ進める ' End If ' Next 'B4 i = 1 Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 For i = 2 To 10 If Worksheets("Sheet1").Cells(i, 2) = "○" Then Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 End If Next 'B3 i = 11 Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 For i = 12 To 22 If Worksheets("Sheet1").Cells(i, 2) = "○" Then Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 End If Next 'B2 i = 23 Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 For i = 24 To 30 If Worksheets("Sheet1").Cells(i, 2) = "○" Then Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 End If Next 'B1 i = 31 Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 For i = 32 To 40 If Worksheets("Sheet1").Cells(i, 2) = "○" Then Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 End If Next End Sub
本当は、普通にプログラミングするときと同じく、関数とかで定義したり(できるのかな?)した方がいいとは思うのですが、なんかこの程度ならいいやって思ったので、つらつらと書き連ねました。
Enjoy VBA Life!
追記(Mon Jan 26 2015 20:08:32 GMT+0900(JST) )
Sub Shukeisan_Kai() ' イベント出欠集計VBA ' Author: cancolle(@wonder_zone) Worksheets("Sheet1").Cells(8, 10) = 1 'B4 Call Shukei(2, 10) 'B3 Call Shukei(12, 22) 'B2 Call Shukei(24, 30) 'B1 Call Shukei(32, 40) Worksheets("Sheet1").Cells(8, 10) = "" End Sub Private Sub Shukei(St As Integer, Fin As Integer) i = St - 1 j = Worksheets("Sheet1").Cells(8, 10) Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 For i = St To Fin If Worksheets("Sheet1").Cells(i, 2) = "○" Then Worksheets("Sheet2").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1) j = j + 1 End If Next Worksheets("Sheet1").Cells(8, 10) = j End Sub
これで、もっとすっきりします。