[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
こんばんは若槻です。きりちゃんのところにぽんと投下してきた
VBAの修正版が出来たから載っけてみます。
「Access VBA マウスホイール制御」
○やりたいこと
→フォームでマウスホイールをするとレコードが移動してしまうので
それをなくす
○ソース
Dim bbb As Integer
'=============================================
' フォームの読み込み時
'=============================================
Private Sub Form_Load()
bbb = 0
End Sub
☆やっていること
フォームの読み込み時に変数ｂｂｂに0を入れる
'=============================================
'レコード移動時
'=============================================
Private Sub Form_Current()
If Me.NewRecord Then Exit Sub
Me.[コントロール名].SetFocus
Me.Dirty = True
End Sub
☆やっていること
レコード移動時の処理。
1.次のレコードが新しいレコードの時は作用しない
2.どれでもいいからコントロールを選んでおく。これを選ばないとエラーになる
3.「Dirty」はカレントレコードの変更の有無を表す。今はTrueなので変更有り
→変更有り＝更新前処理が入る
'=============================================
' マウスホイールを動かした時
'=============================================
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
bbb = Count
End Sub
☆やっていること
マウスホイールが動かされたらｂｂｂにCountの値を入れる
（Countの値＝ホイールされて動こうとしているレコードの数）
'=============================================
' レコードに変更があった時
'=============================================
Private Sub Form_BeforeUpdate(Cancel As Integer)
If bbb <> 0 Then
Cancel = True
bbb = 0
End If
End Sub
☆やっていること
ｂｂｂの値が0でない時にCancelをTrueにして処理をキャンセルする。
※1ここでキャンセルされると移動もキャンセルになる
※2判断は必ず「0でない」にする。ｂｂｂの値はマイナス値にもなる
※3ｂｂｂの値を初期化しておく
（上のレコード移動時の処理を超えると自動的に入ってくる）
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
◎修正前
→前回はString型で文字を入れる感じでやっていたのですが、
思いっきりホイールすると動いてしまったので数値型にしました。
（きりちゃん報告。自分で確認しろよって話ですね分かりまｓ）
細かい原理は理解しきれてませんが多分一気にやるとどっかしらで
値が入らなくなるんだと思います。
というわけで数値型でFA。
※注意※
上のソースは若槻が触る分には特に問題はありませんでしたが、
プログラムによっては不具合を起こす可能性、動作しない可能性も
あります。その場合にこちらで責任を取ることは出来ませんので
ご了承ください。
以下拍手返信です。
サイト拍手含め名無しの拍手の方々もありがとうございます！
[4回]
こんばんは若槻です。本日いきなり仕事が増えました。
仕事があるのはいいんです。だが何で暇な時と忙しい時の
波が激しいんだ（（゜д゜；））!?
大波小波にもほどがある……orz
さて、本日は昨日の続きです。
って言っても、たいしたことじゃないです。長いだけ。
====================================================
◎システム名 「演習-学生名簿」
====================================================
～現在ある内容～
・グループ分け ←終了
・学年別 ←簡単１ ←終了
・学校別 ←終了
・性別ごと ←簡単２ ←終了
・配役配置 ←終了
・試合 ←終了
・検索
・選抜 ←終了
・動き
・条件別グループ分け
本日は「動き」の続きをおしゃべりします。
９．動き
○やりたいこと
これは番外のお遊びソースですね。
学生名簿演習には正直直接関係はありません。
遊び道具を作りたい方は、って感じでしょうか＾＾；
ではスタート。
○ソース
～～～～～～～ソース３．-ここから～～～～～～～～
'=======================================================
'動作-文字タイプ
'=======================================================
Sub MojiType()
[1]
SheetSet
WH13.Range("X1:BG50").Interior.Pattern = xlPatternNone
LG = 2 '塗りつぶし用-行
LR = 25 '塗りつぶし用-列
[2]
Kotoba2 = InputBox(Title:="入力", prompt:="アルファベットで入力してください。" & _
Chr(10) & Chr(13) & "＠マークで改行されます")
If Kotoba2 = "" Then
Exit Sub
End If
[3]
Ren = Len(Kotoba2)
j = 1 'Kotoba2を回す用
Do Until j > Ren
Kotoba = Mid(Kotoba2, j, 1)
If Kotoba = "@" Then
LR = 25
LG = LG + 8
Else
Alphabet
If LR >= 50 Then
LR = 25
LG = LG + 8
Else
LR = LR + 2
End If
End If
j = j + 1
Loop
End Sub
～～～～～～～ソース３．-ここまで～～～～～～～～
ソース３でやってること→アニメーション２、文字タイプ
△これはインプットボックスに入力した値がExcel上に記述されていくソースです。
ただし動作するのは英大文字のみとなっています。
小文字で入れても大文字で入れても全部大文字です
[1]初期動作→塗りつぶしをなくしたり変数の値を初期値にする
[2]記述したい言葉を入力し、変数Kotoba2に代入。
何も入力しなかった場合は処理を抜ける
[3]上の処理で「Excel」と入力したのを前提とします。
1.変数RenにKotoba2の文字数を入れる（今回は５文字）
2.変数KotobaにKotoba2のｊ番目から1文字分を格納
3.Kotobaが「＠」の場合は列数のLRを初期値に戻し、現在の行数に８を足す
「＠」以外の時はマクロ「Alphabet」を呼び出して実行。
それから列数が50以上の時は列数を初期値に戻し、行数に８を追加。
列数が50を超えていない場合は列数に２を追加する。
☆ 以下に記すのはマクロ「Alphabet」です。長いのでご注意を ☆
～～～～～～～ソース４．-ここから～～～～～～～～
=======================================================
'アルファベットごとに塗りつぶしを変える
'=======================================================
Sub Alphabet()
Select Case Kotoba
'◆◇◆ A ◆◇◆
Case "A", "a"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'◆◇◆ B ◆◇◆
Case "B", "b"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓４列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 1, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 3, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ C ◆◇◆
Case "C", "c"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
WH13.Cells(LG + 2, LR).Interior.Pattern = xlPatternNone
'◆◇◆ D ◆◇◆
Case "D", "d"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
i = LG + 1
Do Until i > LG + 3
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'◆◇◆ E ◆◇◆
Case "E", "e"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ F ◆◇◆
Case "F", "f"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ G ◆◇◆
Case "G", "g"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓４列目
LR = LR + 1 '次の列へ
i = LG
Do Until i > LG + 4
If i <> LG + 1 Then
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
End If
i = i + 1
Loop
'◆◇◆ H ◆◇◆
Case "H", "h"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'◆◇◆ I ◆◇◆
Case "I", "i"
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓３列目
LR = LR + 1
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ J ◆◇◆
Case "J", "j"
i = LG
Do Until i > LG + 4
If i <> LG + 1 And i <> LG + 2 Then
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
End If
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓４列目
LR = LR + 1
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ K ◆◇◆
Case "K", "k"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
WH13.Cells(LG + 1, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 3, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓４列目
LR = LR + 1
WH13.Cells(LG, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ L ◆◇◆
Case "L", "l"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
WH13.Cells(LG + 4, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'◆◇◆ M ◆◇◆
Case "M", "m"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 1, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓４列目
LR = LR + 1
WH13.Cells(LG + 1, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓５列目
LR = LR + 1
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'◆◇◆ N ◆◇◆
Case "N", "n"
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
'----------------------------------------↓２列目
LR = LR + 1 '次の列へ
WH13.Cells(LG + 1, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓３列目
LR = LR + 1
WH13.Cells(LG + 2, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓４列目
LR = LR + 1
WH13.Cells(LG + 3, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
'----------------------------------------↓５列目
LR = LR + 1
i = LG
Do Until i > LG + 4
WH13.Cells(i, LR).Interior.ColorIndex = 1
For h = 1 To 10000
DoEvents
Next h
i = i + 1
Loop
※ソース4の残りは追記の中に格納しています。
～～～～～～～ソース４．-ここまで～～～～～～～～
'ソース４でやってること→文字タイプ、アルファベットに塗りつぶし
△長いですがやっているのはその文字になるように1セルずつ
塗りつぶしているだけです。
今回は徐々に描かれるようにしているので
「For h = 1 To 10000
DoEvents
Next h」
が、入ります。これがないと一気に塗られます。
※うまく入りきらなかったものがやけに広くなったり大きくなったり
していますので、もしこのプログラムを実行なさった方がいらっしゃり、
「なんか違和感ある」と思われたらどうぞ改変なさってください。
そして若槻に教えてくだｓ（ｒｙ
～～～～～～～ソース５．-ここから～～～～～～～～
'=======================================================
'塗りつぶし無しにする
'=======================================================
Sub NothingColor()
SheetSet
WH13.Cells.Interior.Pattern = xlPatternNone
End Sub
～～～～～～～ソース５．-ここまで～～～～～～～～
ソース５でやってること→シート「動き」の塗りつぶしを全て無しにする
以上で「動き」は終了です。
お疲れ様でした。
[1回]
こんばんは若槻です。最近仕事がなかったのですが
明日から忙しくなる予感がひしひしと……寝る時間を
確保出来るなら何でもいいですorz
さて、本日は久々にVBAのおしゃべりです。
需要なんて知っちゃこっちゃありません←
====================================================
◎システム名 「演習-学生名簿」
====================================================
～現在ある内容～
・グループ分け ←終了
・学年別 ←簡単１ ←終了
・学校別 ←終了
・性別ごと ←簡単２ ←終了
・配役配置 ←終了
・試合 ←終了
・検索
・選抜 ←終了
・動き
・条件別グループ分け
本日は「動き」をおしゃべりします。
そしてこっそり長いので2回に分けます。
難しいんじゃなくて、長い。
９．動き
○やりたいこと
これは番外のお遊びソースですね。
学生名簿演習には正直直接関係はありません。
遊び道具を作りたい方は、って感じでしょうか＾＾；
ではスタート。
○ソース
～～～～～～～ソース１．-ここから～～～～～～～～
'=======================================================
'動作-まばたき
'=======================================================
Sub Anmtion()
SheetSet
j = 1
Do Until j > 3
[1]
WH13.Range("C4:C8,E4:E8,D10:D12").Interior.ColorIndex = 1
Application.Wait Now() + TimeValue("00:00:01")
[2]
WH13.Range("C4:C8,E4:E8,D10:D12").Interior.Pattern = xlPatternNone
WH13.Range("C6,E6,D10:D12").Interior.ColorIndex = 1
Application.Wait Now() + TimeValue("00:00:01")
j = j + 1
Loop
End Sub
～～～～～～～ソース１．-ここまで～～～～～～～～
ソース１でやってること→アニメーション１
[1]指定しているセルの背景色を黒にする
1秒間だけプログラムを待たせる
「 Application.Wait 時間 」
→「時間」の分だけ処理を一時停止
「 Now() + TimeValue("00:00:01") 」
→「Now」が現在の時間で、TimeValueの値を足すことで
現在の時間から指定した時間分だけ待たせることが出来る
[2]指定したセルの背景色を無しにし、同時に別箇所を黒くする
上と同様に1秒間だけ待機させる
△このソース１のプログラムを実行すると3回分の瞬きが
繰り返されます
～～～～～～～ソース２．-ここから～～～～～～～～
'=======================================================
'動作-表情おみくじ
'=======================================================
Sub Omikuji()
SheetSet
j = 1
WH13.Range("K2:T11").Interior.Pattern = xlPatternNone
Randomize
h = Int(Rnd() * 3) + 1
Select Case h
Case 3
WH13.Range("L4,N4,Q4,S4").Interior.ColorIndex = 1
WH13.Range("M3,R3,N8,Q8").Interior.ColorIndex = 1
WH13.Range("N7:Q7,O9:P9").Interior.ColorIndex = 1
Case 2
WH13.Range("L4,N4,Q4,S4").Interior.ColorIndex = 1
WH13.Range("M5,R5,N8:Q8").Interior.ColorIndex = 1
Case 1
WH13.Range("L4,N4,Q4,S4,M5,R5").Interior.ColorIndex = 1
WH13.Range("N9,Q9,O8:P8").Interior.ColorIndex = 1
End Select
End Sub
～～～～～～～ソース２．-ここまで～～～～～～～～
ソース２でやってること→ランダムで出した値によって塗りつぶす範囲を変える
1.対象範囲の塗りつぶしを無しにする
2.変数ｈにランダムで値を入れる
3.ｈの値によって場合わけを行い、表情を作る
以上で今回の「動き」は終了です。
お疲れ様でした。
以下拍手返信です。
[1回]
こんばんは若槻です。GWまであと1日。GW入ったら仕上げられる奴は
なるべく全部仕上げられるように頑張りたいと思います（－ω－）
さて、それでは本日はそろそろ仕上げなのでまたVBAで。
====================================================
◎システム名 「演習-学生名簿」
====================================================
～現在ある内容～
・グループ分け ←終了
・学年別 ←簡単１ ←終了
・学校別 ←終了
・性別ごと ←簡単２ ←終了
・配役配置 ←終了
・試合 ←終了
・検索
・選抜
・動き
・条件別グループ分け
本日は「選抜」をおしゃべりします。
８．選抜
○やりたいこと
前回の「試合」同様単純にメンバーを振り分けているだけです。
A～Fの6グループに適当に11人振り分ける
○ソース
～～～～～～～ソース１．-ここから～～～～～～～～
'============================================================
'選抜抜き出し
'============================================================
Sub Senbatu()
[1]
SheetSet
DontLook
SyokiCopy
WH2.Range("1:1").Delete
WH11.Cells.Delete
'項目名の入力
WH11.Range("A1,G1").Value = "選抜タイプ"
WH11.Range("B1,H1").Value = "名前"
WH11.Range("C1,I1").Value = "性別"
WH11.Range("D1,J1").Value = "学校"
WH11.Range("E1,K1").Value = "学年"
'罫線を引く-２重線
WH11.Range("A1:E1").Borders(xlEdgeBottom).LineStyle = xlDouble
WH11.Range("G1:K1").Borders(xlEdgeBottom).LineStyle = xlDouble
'罫線を引く-中太線
WH11.Range("A12:E12").Borders(xlEdgeBottom).Weight = xlMedium
WH11.Range("A23:E23").Borders(xlEdgeBottom).Weight = xlMedium
WH11.Range("G12:K12").Borders(xlEdgeBottom).Weight = xlMedium
WH11.Range("G23:K23").Borders(xlEdgeBottom).Weight = xlMedium
'罫線を引く-囲い線1
WH11.Range("A1:E1").Borders(xlEdgeTop).LineStyle = xlContinuous
WH11.Range("E1:E34").Borders(xlEdgeRight).LineStyle = xlContinuous
WH11.Range("A34:E34").Borders(xlEdgeBottom).LineStyle = xlContinuous
WH11.Range("A1:A34").Borders(xlEdgeLeft).LineStyle = xlContinuous
'罫線を引く-囲い線2
WH11.Range("G1:K1").Borders(xlEdgeTop).LineStyle = xlContinuous
WH11.Range("K1:K34").Borders(xlEdgeRight).LineStyle = xlContinuous
WH11.Range("G34:K34").Borders(xlEdgeBottom).LineStyle = xlContinuous
WH11.Range("G1:G34").Borders(xlEdgeLeft).LineStyle = xlContinuous
'罫線を引く-区切り線
WH11.Range("A1:A34").Borders(xlEdgeRight).LineStyle = xlContinuous
WH11.Range("G1:G34").Borders(xlEdgeRight).LineStyle = xlContinuous
'選抜名入力
WH11.Range("A2:A12").MergeCells = True
WH11.Range("A2").Value = "選抜A"
WH11.Range("A13:A23").MergeCells = True
WH11.Range("A13").Value = "選抜B"
WH11.Range("A24:A34").MergeCells = True
WH11.Range("A24").Value = "選抜C"
WH11.Range("G2:G12").MergeCells = True
WH11.Range("G2").Value = "選抜D"
WH11.Range("G13:G23").MergeCells = True
WH11.Range("G13").Value = "選抜E"
WH11.Range("G24:G34").MergeCells = True
WH11.Range("G24").Value = "選抜F"
'中央寄せ
WH11.Range("A1:E1").HorizontalAlignment = xlCenter
WH11.Range("G1:K1").HorizontalAlignment = xlCenter
WH11.Range("A2,A13,A24,G2,G13,G24").HorizontalAlignment = xlCenter
'選抜-太字と角度変更
WH11.Range("A2,A13,A24,G2,G13,G24").Font.Size = 14
WH11.Range("A2,A13,A24,G2,G13,G24").Font.Bold = True
WH11.Range("A2,A13,A24,G2,G13,G24").Orientation = 45
[2]
'選抜A
h = 2
Do Until h > 12
GroupNo = 1
SenbatuKaiten
Loop
'選抜B
h = 13
Do Until h > 23
GroupNo = 1
SenbatuKaiten
Loop
'選抜C
h = 24
Do Until h > 34
GroupNo = 1
SenbatuKaiten
Loop
'選抜D
h = 2
Do Until h > 12
GroupNo = 2
SenbatuKaiten
Loop
'選抜E
h = 13
Do Until h > 23
GroupNo = 2
SenbatuKaiten
Loop
'選抜F
h = 24
Do Until h > 34
GroupNo = 2
SenbatuKaiten
Loop
[3]
'列幅のオートフィット
LR = WH11.UsedRange.Columns.Count
For i = 1 To LR
WH11.Rows(i).EntireColumn.AutoFit
Next
WH11.Select
WH11.Range("M1").Select
OKLook
End Sub
～～～～～～～ソース１．-ここまで～～～～～～～～
ソース１でやってること→メイン動作
[1]初期動作
1.学生一覧をコピーして1行目の項目行を削除
2.シート「選抜」内のデータを空にする
3.項目名を格納
4.各所に罫線を引く
5.グループ名を入れてセルを結合
6.中央寄せやフォント等の変更を行う
※「Range("A1").Font.Size = 14」
→A1のフォントサイズを14にする。ここで指定される値は
通常のExcelで設定する値と同様に考える
※「Range("A1").Font.Bold = True」
→A1のフォントに太字が追加される（外す場合はFalseにする）
→ちなみに斜体は「.Italic = True」にすればよい
※「Range("A1").Orientation = 45」
→A1の配置が45度の角度で傾く
[2]各グループに振り分け。変数ｈは行数、変数GroupNoは列数
※GroupNoの場合、A～Cが１、D～Fが２となる
→マクロSenbatuKaitenを呼び出し（後述）
[3]最終処理
→最終列までのオートフィット
～～～～～～～ソース２．-ここから～～～～～～～～
'値入れ
Sub SenbatuKaiten()
LG = WH2.Range("A65536").End(xlUp).Row
Randomize
j = Int(Rnd() * LG) + 1
Select Case GroupNo
Case 1
WH11.Range("B" & h).Value = WH2.Range("B" & j).Value
WH11.Range("C" & h).Value = WH2.Range("D" & j).Value
WH11.Range("D" & h).Value = WH2.Range("E" & j).Value
WH11.Range("E" & h).Value = WH2.Range("F" & j).Value
Case 2
WH11.Range("H" & h).Value = WH2.Range("B" & j).Value
WH11.Range("I" & h).Value = WH2.Range("D" & j).Value
WH11.Range("J" & h).Value = WH2.Range("E" & j).Value
WH11.Range("K" & h).Value = WH2.Range("F" & j).Value
End Select
WH2.Range(j & ":" & j).Delete
h = h + 1
End Sub
～～～～～～～ソース２．-ここまで～～～～～～～～
ソース２でやってること→値の転記
1.ランダムで選んだ値をｊに代入
2.GroupNoの値によって場合分けをし、データを転記
3.転記された元データの行を削除
以上で「選抜」は終了です。
お疲れ様でした。
～おまけ～
「同一セル内でもこの部分だけを変えたい！」ということってありませんか？
そんな時はこれ。
「Characters（開始位置、文字数）」
配置的には
「Range("A1").Characters(4, 3) .Font.Size = 15」
で、たとえばA1に「AbcDefGhi」という文字列が入っている場合、
上の設定だと「Def」の部分の文字サイズが15になります。
※ちなみに同一セル内に複数の設定を入れることも可能
＜Ex＞
1.Range("A2").Value = Range("A1").Value
WH11.Range("A2").Characters(1, 1).Font.Italic = True
→1文字目だけ斜体になる
2.Range("A3").Value = Range("A1").Value
Range("A3").Characters(1, 1).Font.Bold = True
→ 1文字目だけ太字になる
3.Range("A4").Value = Range("A1").Value
With Range("A4")
.Characters(1, 1).Font.Bold = True
.Characters(2, 1).Font.Italic = True
.Characters(1, 1).Font.Size = 15
End With
→1文字目が太字でフォントサイズ15に、2文字目が斜体になる
[1回]
こんばんは若槻です。以前TOUYAさんに回していただいたバトンの
下書きをしていました。とうまくんから匙投げられたからこれを
4,000Hitのお礼絵に転用しようと画策中←
さて、本日は連続になりますがVBAのおしゃべりです。
需要がなかろうとしっちゃこっちゃありません（笑
====================================================
◎システム名 「演習-学生名簿」
====================================================
～現在ある内容～
・グループ分け ←終了
・学年別 ←簡単１ ←終了
・学校別 ←終了
・性別ごと ←簡単２ ←終了
・配役配置 ←終了
・試合
・検索
・選抜
・動き
・条件別グループ分け
本日は試合をおしゃべりします。
７．試合
○やりたいこと
試合といってもやるのは組み合わせを作るだけです。
キャラクターに何かしら値を持たせれば試合まで行うのも可能ですかね。
ですが今回はユーザーフォームで指定した条件ごとに
組み分けをする、というところまでになります。
○使用変数
Public Kumiawase As String
Public Gakunen As Integer
Public Kaisuu As String
'ユーザーフォーム用
Public ListCNT As Integer
Public Naiyou(2) As String
Public Kakuho As Integer
○ソース
～～～～～～～ソース１．-ここから～～～～～～～～
'================================================
'試合配置
'================================================
Sub SiaiHaiti()
SheetSet
DontLook
[1]
'=============ウィンドウ枠の解除
ActiveWindow.FreezePanes = False
[2]
'====================WH8のデータの削除
LG = WH8.Range("A65536").End(xlUp).Row
If LG > 1 Then
WH8.Range("A2:O" & LG).Delete
End If
[3]
'=====WH2にWH1のデータをコピーして並び替え===========
SyokiCopy
[4]
'ユーザーフォームの読み出し
UserForm1.Show
[5]
'==========組み合わせ==========
Select Case True
Case Kumiawase = "男子"
OutGirl
Case Kumiawase = "女子"
OutBoy
End Select
'学年
Select Case True
Case Gakunen = 1
OutOtherFirst
Case Gakunen = 2
OutOtherSecond
Case Gakunen = 3
OutOtherThird
Case Gakunen = 12
OutThird
Case Gakunen = 13
OutSecond
Case Gakunen = 23
OutFirst
End Select
'人数ごとに振り分け
Select Case Nin
Case 1
OneOnOne
Case 2
MixDouble
End Select
[6]
'行の高さ変更
WH8.Range("1:" & LG).RowHeight = 22.5
'罫線
With WH8.Range("A1:I" & LG)
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
'背景色
WH8.Range("A1:I" & LG).Interior.ColorIndex = 2
'全体を中央寄せ
WH8.Range("A:I").HorizontalAlignment = xlCenter
WH8.Select
'ウィンドウ枠の固定
WH8.Range("2:2").Select
ActiveWindow.FreezePanes = True
WH8.Range("J2").Select
OKLook
End Sub
～～～～～～～ソース１．-ここまで～～～～～～～～
ソース１でやってること→メイン動作。各マクロの呼び出し
[1]ウィンドウ枠固定の解除
→何回か前にも書いたかもしれませんが、これはやっておかないと
最終のウィンドウ枠固定がうまく機能しなくなってしまいます。
[2]A列の2行目からO列のLG（最終行）目までをデリート
[3]学生一覧のデータを作業用のシート「並べ替え」にコピー
[4]ユーザーフォームの呼び出し
→ユーザーフォーム自体のコードは下で喋りますのでここでは
「呼び出しましたよ」ってことだけお伝えします。
※ちなみにここでは「組み合わせ」「人数」「学年」を選択し、
その結果ごとに以降の行動が決まります。
[5]ユーザーフォーで選択した値によって行を選抜していく
「組み合わせ」→「混合」：何もしない
「男子」：OutGirl = 女子の行を削除
「女子」：OutBoy = 男子の行を削除
「学年」 →「全学年」 ：何もしない
「1年と2年」：OutThird = 3年の行を削除
「1年と3年」：OutSecond = 2年の行を削除
「2年と3年」：OutFirst = 1年の行を削除
「1年」 ：OutOtherFirst = 1年以外を削除
「2年」 ：OutOtherSecond = 2年以外を削除
「3年」 ：OutOtherThird = 3年以外を削除
「人数」 →「1人」：1対1の組み合わせを作る
「2人」：2対2の組み合わせを作る
[6]最終処理
1.行の高さの変更
◎行の高さと列の幅◎
.RowHeight = 数字 ←行の高さは「ポイント」で表されています
.ColumnWidth = 数字 ←列の幅は「標準フォントで何文字分の幅」で表されます
いまいち分かりづらいので若槻は列幅を決めるときは
一回現在の列幅を出してから調整してます。
分かる人なら多分すぐに分かるかと！
※標準フォント=「ツール」→「オプション」→「全般タブ」で見られます
2.罫線を引く
3.データが入ったところにだけ背景色を白にする
4.全体を中央寄せ
5.ウィンドウ枠を固定
～～～～～～～～ソース２．-ここから～～～～～～～～
'==================================================
'性別【女子】の行を消す
'==================================================
Sub OutGirl()
LG = WH2.Range("A65536").End(xlUp).Row
k = 2
Do Until k > LG
If WH2.Range("D" & k).Value = "女" Then
WH2.Range(k & ":" & k).Delete
k = k - 1
End If
k = k + 1
Loop
End Sub
～～～～～～～～ソース２．-ここまで～～～～～～～～
ソース２でやってること→性別が「女」の行を削除する
△最終行を求め、Do Loopを回して1行ずつ見ていきます。
一致した行は消し、1行分が減ったので変数ｋからも
1を引きます。
※前にも書きましたが、ここで1を減らさないと
消した分だけ見ている行がずれていってしまい、
最終的に消えるべき行が生き残ってしまいます。
☆以下に
・OutBoy
・OutOtherFirst
・OutOtherSecond
・OutOtherThird
・OutFirst
・OutSecond
・OutThird
が続きますが、やっていることはOutGirlと同じなので省略します。
～～～～～～～～ソース３．-ここから～～～～～～～～
'=============================================
'対戦-1対1
'=============================================
Sub OneOnOne()
[1]
'=====全体の人数が奇数だった時に偶数に調整
LG = WH2.Range("A65536").End(xlUp).Row
If LG Mod 2 = 1 Then
LG2 = LG - 1
Kaisuu = Int(LG2 / 2)
Else
Kaisuu = Int(LG / 2)
End If
[2]
YobunIdou
[3]
Ramdam
j = 2 'WH8－行用
h = 1 'WH8－列用
Do Until j > Kaisuu
Select Case h Mod 2
Case 1
WH8.Range("A" & j).Value = WH2.Range("B" & i).Value
WH8.Range("B" & j).Value = WH2.Range("E" & i).Value
WH8.Range("C" & j).Value = WH2.Range("F" & i).Value
WH8.Range("D" & j).Value = WH2.Range("D" & i).Value
h = h + 1
Case 0
WH8.Range("F" & j).Value = WH2.Range("B" & i).Value
WH8.Range("G" & j).Value = WH2.Range("E" & i).Value
WH8.Range("H" & j).Value = WH2.Range("F" & i).Value
WH8.Range("I" & j).Value = WH2.Range("D" & i).Value
j = j + 1
h = h + 1
End Select
WH2.Range(i & ":" & i).Delete
LG = WH2.Range("A65536").End(xlUp).Row
If LG > 2 Then
Ramdam
ElseIf LG <> 1 Then
i = LG
Else
Exit Do
End If
Loop
[4]
'列幅のオートフィット
For i = 1 To 11
WH8.Rows(i).EntireColumn.AutoFit
Next
'E列に"VS"入力して幅を変更
LG = WH8.Range("A65536").End(xlUp).Row
WH8.Range("E2:E" & LG).Value = "VS"
WH8.Range("E:E").ColumnWidth = 20
'1行ごとに罫線
For i = 2 To LG
WH8.Range("A" & i & ":I" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous
Next
End Sub
～～～～～～～～ソース３．-ここまで～～～～～～～～
ソース３でやってること→1対1の組み合わせを作る
[1]まずはLGに最終行を求めます。
※この段階のLGの値は「全体」と「項目行」なので全体数より１多い
次に、そのLGを2で割ったあまりを求めます（modは除算のあまりを求める）
※ここで2で割っているのは、試合で１対１をやる場合１ゲームに
「2人」が必要となるからです。
その次に２で割っているのはループを回す数を求めるためです。
[2]YobunIdouを実行（後述）
[3]Kaisuuに格納された数の分だけループを回す
1.列用の変数ｈの値が奇数の時は左の列に、偶数の時は右の列に
データを格納します
2.ｉ列目のデータは格納されたら削除します
3.残された行数（人数）が少なくなってきたらｉの値は最終行
[4]1.列幅のオートフィット
2.互いの間に「ＶＳ」と入れ、列幅を20にする
3.罫線を引く
～～～～～～～～ソース４．-ここから～～～～～～～～
'=============================================
'対戦-2対2
'=============================================
Sub MixDouble()
[1]
'=====全体の人数が奇数だった時に偶数に調整
LG = WH2.Range("A65536").End(xlUp).Row
If LG Mod 2 = 1 Then
LG2 = LG - 1
Kaisuu = (LG2 / 2) + 1
End If
[2]
YobunIdou
[3]
Ramdam
j = 2 'WH8－行用
h = 1 'WH8－列用
Do Until j > Kaisuu
Select Case h Mod 2
Case 1
WH8.Range("A" & j).Value = WH2.Range("B" & i).Value
WH8.Range("B" & j).Value = WH2.Range("E" & i).Value
WH8.Range("C" & j).Value = WH2.Range("F" & i).Value
WH8.Range("D" & j).Value = WH2.Range("D" & i).Value
h = h + 1
Case 0
WH8.Range("F" & j).Value = WH2.Range("B" & i).Value
WH8.Range("G" & j).Value = WH2.Range("E" & i).Value
WH8.Range("H" & j).Value = WH2.Range("F" & i).Value
WH8.Range("I" & j).Value = WH2.Range("D" & i).Value
j = j + 1
h = h + 1
End Select
WH2.Range(i & ":" & i).Delete
LG = WH2.Range("A65536").End(xlUp).Row
If LG > 2 Then
Ramdam
ElseIf LG <> 1 Then
i = LG
Else
Exit Do
End If
Loop
[4]
'列幅のオートフィット
For i = 1 To 11
WH8.Rows(i).EntireColumn.AutoFit
Next
'E列に"VS"入力して幅を変更
LG = WH8.Range("A65536").End(xlUp).Row
For i = 2 To LG Step 2
WH8.Range("E" & i).Value = "VS"
WH8.Range("E" & i & ":E" & i + 1).MergeCells = True
Next
WH8.Range("E:E").ColumnWidth = 20
'1行ごとに罫線
For i = 3 To LG Step 2
WH8.Range("A" & i & ":I" & i).Borders(xlEdgeBottom).Weight = xlMedium
Next
End Sub
～～～～～～～～ソース４．-ここまで～～～～～～～～
ソース４でやってること→2対2の組み合わせを作る
[1]～[3]OneOnOneでやっていることと同じなので割愛
[4]1.列幅のオートフィット
2.「2行ごと」に「VS」の値を入れてセルを結合し、列幅を20にする
3.「2行ごと」に罫線を引く
※「Step △」
For文を書く時に、1行ずつの処理をしたい場合は何も書かなければ
いいのですが、2行ごとや3行ごとなど飛ばし飛ばしの処理をしたい場合は
「For 変数 = 始まりの数 To 終わりの数 Step 処理をしたい数」
とする。
今回の「For i = 3 To LG Step 2」の場合は
変数ｉが3から始まりLGまで2行おきに処理がされます。
～～～～～～～～ソース５．-ここから～～～～～～～～
'==========================================
'余分な人数分をあまりスペースに格納
'==========================================
Sub YobunIdou()
Ramdam
LG = WH2.Range("A65536").End(xlUp).Row - 1
Select Case Nin
Case 1
l = LG Mod 2
Case 2
l = LG Mod 4
End Select
k = 2
If l > 0 And LG > 1 Then
Do Until l = 0
WH8.Range("K" & k).Value = WH2.Range("B" & l + 1).Value
WH8.Range("L" & k).Value = WH2.Range("E" & l + 1).Value
WH8.Range("M" & k).Value = WH2.Range("F" & l + 1).Value
WH8.Range("N" & k).Value = WH2.Range("D" & l + 1).Value
WH2.Range(l + 1 & ":" & l + 1).Delete
k = k + 1
l = l - 1
Loop
End If
End Sub
～～～～～～～～ソース５．-ここまで～～～～～～～～
ソース５でやってること→あまりになる人数分メンバーを抜き出す
・人数を求め、その最終行を2、または4で割る
※割る値は試合人数によって変わる
・試合人数が2人：あまりがある場合は最大1人
・試合人数が4人：あまりがある場合は最大3人
・最大人数を各数で割ったあまりの値の分ループさせ、
シート「試合」のあまりスペースに代入していき、
終了後はその行を削除する
以下が条件別のユーザーフォームとその結果です
[0]デフォルト
[1]組み合わせ：混合、人数：2人、学年：1年･2年
[2]組み合わせ：女子、人数：1人、学年：1年
ここからはユーザーフォームの中のソースです
～～～～～～～～ソース６．-ここから～～～～～～～～
'===================================
'フォームを読み込む時に初期化
'===================================
Private Sub UserForm_Initialize()
Me.OP混合.Value = True
Me.OB全学年.Value = True
Me.OB1人.Value = True
With Me.ListBox1
.AddItem "組み合わせ：混合"
.AddItem "人数：１人"
.AddItem "学年：全学年 "
End With
End Sub
～～～～～～～～ソース６．-ここまで～～～～～～～～
ソース６でやっていること→初期化
・ユーザーフォームを読み込んだ時の処理です。
「UserForm_Initialize」はユーザーフォームの処理で
一番早くに実行されます
・ここでは組み合わせ、学年、人数のオプションに初期の値を入れ、
リストボックスに現在の条件を格納
～～～～～～～～ソース７．-ここから～～～～～～～～
'===================================================
'開始ボタンを押した時
'===================================================
Private Sub CB開始_Click()
Unload Me
End Sub
～～～～～～～～ソース７．-ここまで～～～～～～～～
ソース７でやっていること→ユーザーフォームを閉じる
～～～～～～～～ソース８．-ここから～～～～～～～～
'========================================
'組み合わせ
'=========================================
Private Sub OP混合_Click()
[1]
ListCNT = Me.ListBox1.ListCount - 1
i = 0
[2]
NaiyouKakunou
[3]
Naiyou(0) = "組み合わせ：混合"
i = 0
Do Until i > ListCNT
Me.ListBox1.AddItem Naiyou(i)
i = i + 1
Loop
Kumiawase = "混合"
End Sub
～～～～～～～～ソース８．-ここまで～～～～～～～～
ソース８でやっていること→組み合わせ条件を選択
[1]リストボックスの行数(-1)を求める
※リストボックス内の配列を扱うための値なので1を引く
Ex)行数が1→配列は0
行数が2→配列は0と1
[2]マクロNaiyouKakunouの呼び出し（後述）
[3]・変数Naiyou(0)に条件文を格納
※"組み合わせ："までは同一、以降は混合･男子･女子と変わる
・リストボックスに条件の格納
・変数Kumiawaseに条件を格納(混合、男子、女子のいずれか)
☆以下に
・OB男子_Click
・OB女子_Click
が続くが、やっていることは同じなので割愛
～～～～～～～～ソース９．-ここから～～～～～～～～
'========================================
'人数
'=========================================
Private Sub OB1人_Click()
[1]
ListCNT = Me.ListBox1.ListCount - 1
i = 0
[2]
NaiyouKakunou
[3]
Naiyou(1) = "人数：１人"
i = 0
Do Until i > ListCNT
Me.ListBox1.AddItem Naiyou(i)
i = i + 1
Loop
Nin = 1
End Sub
～～～～～～～～ソース９．-ここまで～～～～～～～～
ソース９でやっていること→人数条件を選択
[1]～[3]やっていることは大体同じ
[3]変数Ninに指定人数を格納（1人:1、2人：2）
・変数Naiyou(0)に条件文を格納
※"組み合わせ："までは同一、以降は混合･男子･女子と変わる
・リストボックスに条件の格納
・変数Kumiawaseに条件を格納(混合、男子、女子のいずれか)
☆以下に
・OB2人_Click
が続くが、やっていることは同じなので割愛
～～～～～～～～ソース10．-ここから～～～～～～～～
'========================================
'学年
'=========================================
Private Sub OB全学年_Click()
[1]
ListCNT = Me.ListBox1.ListCount - 1
i = 0
[2]
NaiyouKakunou
[3]
Naiyou(2) = "学年：全学年"
i = 0
Do Until i > ListCNT
Me.ListBox1.AddItem Naiyou(i)
i = i + 1
Loop
Gakunen = 0
End Sub
～～～～～～～～ソース10．-ここまで～～～～～～～～
ソース10でやっていること→学年条件を選択
[1]～[3]やっていることは大体同じ
[3]変数Gakunenに条件に合った値を入れる
混合：０、１年：１、２年：２、３年：３、
1･2年：12、1･3年：13、2･3年：23
☆以下に
・OB1年_Click
・OB2年_Click
・OB3年_Click
・OB1年2年_Click
・OB1年3年_Click
・OB2年と3年_Click
が続くが、やっていることは同じなので割愛
～～～～～～～～ソース11．-ここから～～～～～～～～
'===================================
'内容を変数に入れておく
'===================================
Sub NaiyouKakunou()
Do Until i > ListCNT
Naiyou(i) = Me.ListBox1.List(i, 0)
i = i + 1
Loop
Me.ListBox1.Clear
End Sub
～～～～～～～～ソース11．-ここまで～～～～～～～～
ソース11でやっていること→変数Naiyouにリストの値を移す
・現在入っているリストの内容をｉの値が一致する
配列変数Naiyouに格納していく
・格納後リストをクリア（これをしないと前のものの続きに
データが入ってしまう）
※リストボックスへの「Add Item」で上書きは出来ません
△「ListBox.List(行番号、列番号)」
リストボックスの値を指定する場合おそらく一番簡単な方法。
列数を指定していない場合、列数は必ず1列なので、
配列的な考えで行くと「０」になります。
行番号も同様の考え方をするので、1列目・3行目のデータを
選ぶときは、
「ListBox.List(2,0)」
となります。
以上で「試合」は終了です。
ではお疲れ様でした～。
[0回]
管理画面
