派遣事務員の迷走

派遣事務員コロ子。会社の犬。顔出しNG。常に迷走している。

上のセルの値だけをコピーするマクロ（フィルターしていてもOK)

VBA

こんにちは。
派犬事務員のコロ子です。

上のセルの値だけをコピーしたい

Excelで上の行をコピーするショートカットキーの「Ctrl + D」。
便利だけど、フィルターされていると、実際の一行上のセルがコピーされるし、
また書式もコピーされるから色とか字体とかもコピーされる。
上のセルの値だけコピーしたいときあるよね？


例えば、

f:id:SNegishi:20190908220720p:plain

このような表で種目AAAでフィルターする。

f:id:SNegishi:20190908220602p:plain

この状態で「Ctrl + D」を押す。

すると、見えている状態（可視セル）の「123-456-789」でなくて、実際の一つ上のセルの「333-1123-456」が入力される。
（いつもフィルターしている事を忘れて失敗する）

また、こんな場合

f:id:SNegishi:20190908231723p:plain

上の行に色が付いている。
この場合は色ごとコピーされる。値だけでいいのに・・・。

上の値だけをコピーするショートカットキーが欲しい。

ということで、自作してみた。

一行上の可視セルの値だけをコピーするマクロ

①個人用マクロブック「PERSONAL.XLSB」にマクロを作成する

「PERSONAL.XLSB」にマクロを作成すれば、そのパソコンならどのエクセルファイルでも使える。

個人用マクロブックを一度も使っていない場合は「PERSONAL.XLSB」はないので作成する。

【作成方法】

開発タブのマクロの記録をクリック。
f:id:SNegishi:20190908223125p:plain

割り当てたいショートカットキーを入力する。
（コロ子は「Ctrl＋b」にした。）

マクロの保存先に「個人用マクロブック」を選択してOKボタンをクリック。
f:id:SNegishi:20190908223730p:plain

何か適当に操作して、マクロの記録を終了する。

VBEエディタを見ると「PERSONAL.XLSB」が作成されている。

f:id:SNegishi:20190908224130p:plain

ちなみに「PERSONAL.XLSB」はWindows10では
C:\Users\[user]\AppData\Roaming\Microsoft\Excel\XLSTARTに作成される。


②「PERSONAL.XLSB」の標準モジュールにコードを書く。

【考え方】
①カーソル位置より上の可視セルの範囲を取得する（複数列ある場合は先頭列のみ）
f:id:SNegishi:20190910195834p:plain

②取得した範囲の各々のセルの行番号を配列に格納する

③配列で2番目に大きい行番号が一行上の可視セル。
（一番大きい行番号はカーソル位置）

④一行上の行番号の範囲（カーソル位置と同じ大きさの範囲）をコピー

⑤カーソル位置に値のみを張り付ける

【コード】

Sub PasteValue()

Dim Myrange As Range
Dim MyRow As Long
Dim MyColumn As Long
Dim VisibleRange As Range

Set Myrange = Selection
MyRow = Myrange.Row
MyColumn = Myrange.Item(1).Column '選択範囲の先頭の列

'①MyColumn列の1行目からMyRow行目までの可視セルの範囲を取得
Set VisibleRange = _
Range(Cells(1, MyColumn), Cells(MyRow, MyColumn)).SpecialCells(xlCellTypeVisible)

Dim buf As Range
Dim RowArr() As Long
Dim i As Long

'②配列に行番号を格納する
i = 1
For Each buf In VisibleRange
    
    ReDim Preserve RowArr(i)
    
    RowArr(i) = buf.Row
    i = i + 1

Next buf

'③RowArr配列の2番目に大きい数字（一行上の行番号）を取得する
Dim OneUpRow As Long
OneUpRow = WorksheetFunction.Large(RowArr, 2)

'④一行上の行番号の範囲をコピー
Myrange.Offset(-(MyRow - OneUpRow), 0).Copy

'⑤値のみ貼り付け
Myrange.PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub


これで「Ctrl＋b」で上の可視セルの値だけがコピーできる！

すごく便利だったから、職場で「このマクロいる？」ってみんなにメールしてみたけど、誰からも反応は無かった。
一般的な需要じゃないのか・・・。

ちなみに新しく「PERSONAL.XLSB」を作った場合は、エクセルを開くたびに、「PERSONAL.XLSB」も一緒に開くので表示タブの「表示しない」を選択し、非表示にしておけばOK。

コロ子、VBA For文を勘違いしていた（ループの途中で行が増えたら）

VBA

こんにちは。

派犬事務員のコロ子です。

VBA For文（またもやコロ子勘違いしていた）

VBAでFor文って基本中の基本。一番最初に覚えた構文。
そんなFor文でコロ子、最近までまたもや勘違いしていた。

For文のループ回数は途中で変更できない！？

先日、こんなコードを書いた

Dim i as Long

For i = 1 to Cells(Rows.Count, 1).End(xlUp).Row

	ループの途中で行を挿入

Next i

あれ？
途中で行を挿入したら、最終行までループしていない。
Cells(Rows.Count, 1).End(xlUp).Row
は最終行の行番号が取れるから、行が増えたら最終行の行番号も増えて、ループ回数も増えるよね？？

おかしい、と思って調べてみた。
下記コードでループ回数Aを途中で5回から10回に増やしてみる。

Sub test1()

Dim A As Long
Dim i As Long

A = 5

For i = 1 To A
    
    If i = 3 The
        A = 10
    End If
    
    Debug.Print i

Next i

End Sub

【結果】イミディエイトウインドウ

 1 
 2 
 3 
 4 
 5

5回しかループしてない。何で？
1行づつ実行してみたら原因が判明。

下記のような場合

① 　For i = 1 To 3

② 　　Debug.Print i

③ 　Next i

プログラムが実行される順番は
①→②→③→②→③→②→③

えっ！！！
①は最初の1回しか通っていない。あとは②と③をループ回数繰り返す。

だから途中でループ回数の値を変更しても、ループ回数は変更しないのかー。
知らなかった。

【ちなみにDo～Loopの場合】

① Do While i < 3

②　　Debug.Print i
　　　i = i + 1

③ Loop

プログラムが実行される順番
①→②→③→①→②→③→①→②→③→①

こちらは予想通り、最後に①で式がTrueになっているかを判定している。


でも、For文で絶対ループ回数を変更できない訳ではない。
カウンターの変数を変更したら、ループ回数は変更する。

Sub test()

Dim i As Long

For i = 1 To 5

   If i = 3 Then
        i = 10
   End If
   
   Debug.Print i

Next i

End Sub

【結果】イミディエイトウインドウ

 1 
 2 
 10

これってNext iで何かを判定しているって事なの？この辺りが謎。

とことで、ループの途中で行が増えたらどうするの？

下からループすればOK。（行削除の場合と同じ）

Dim i as Long

For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1

	ループの途中で行を挿入

Next i

ノンプロ研定例会（ノンプログラマーの為の社内VBA&GAS活用法）に参加してきました。

派犬日記

こんにちは。
派犬事務員のコロ子です。

ノンプロ研定例会！

ノンプロ研定例会に参加してきました！
今回のテーマは「ノンプログラマーの為の社内VBA&GAS活用法」
これはすごい興味ある。みんなどんなどうやって業務にVBA(GAS）を活用しているのか興味津々。コロ子いつも一人でやっているから、どうも視点が狭くなりがち。他の人の「こんな事やっています！」が凄い刺激になる。

VBA活用法に登壇されたのが、セラエノ (id:celaeno42) さん。この方VBAでニューラルネットワークとやらも作れちゃう超達人！業務にどんな風に活用しているかの知りたーい！

VBAは何でもできる

セラエノさんの会社、結構ルールがガチガチでコロ子の環境と良く似てる。
アプリのインストール不可などものともせず、VBAでいろいろ作りまくる。
「VBAはMicrosoft officeだけでしか使えない」なんて固定概念をぶっ壊して
くれたわよ！凄すぎて「そんな事できちゃっていいの？」って思わず笑っちゃう。

社外秘のファイルを閲覧のみで表示する、というのを作られていて、マウスを動かすと表示が消えて、もちろん画面のキャプチャも取れない仕組みになっている。
コロ子の会社でも、閲覧のみでプリント不可のファイルがあるんだけど、ちょっとした裏技でプリントできちゃう。（ちゃんとシュレッダーで破棄しています）コロ子の会社の情シスより1枚、2枚、いや100枚くらい上手。凄すぎ！

セラエノさん、ここまで来るのに「運が良かった」「勝手に信用される」などと言っていたけど、絶対にそんなはずはない。
「運」なんて良いときも、悪いときもみんなそれなりにあるし、「信用」なんて勝手にされるものでもない。

セラエノさんのプレゼンを聞いて思ったことは
与えられた仕事以上の仕事をこなし、みんなが便利になるための労力を惜しまず、そして人を立てる。

できる人だ。

自分はどうだろうか・・・？

報酬以上の仕事をしないと「成功できない」と何かで読んだことがある。
いつもお給料が低いことに文句を言っているけど、はたしてその給料以上の働きが出来ているのか・・・？
コロ子の部署ではVBAはコロ子一人しかできないから、大した技術もないのに、みんなより自分の方ができるとか勘違いして天狗になっているのではないか？

「うぇ～ん。違うよー。（涙）」
最初はみんなの役に立ちたくて、チームの為にできることをしようと思っていたのに。みんなにはみんなの仕事があって忙しいから、だから事務員のコロ子がみんなの代わりにVBAを覚えればいい、と思っていたのに。なのにいつの間にか、「認めて貰えない」「頑張ってもお給料が上がらない」とか、文句ばっかり。そんなんじゃ、誰からも信用されない。

コロ子の現実

ある事件をきっかけに、コロ子、会社での信用を無くしてしまった気がする。
そして、コロ子も会社を信用できなくなった。
「派犬だから」で済ませばそれはそれでいいのかも知れない。
でも、でも・・・。

今、上手くいっていない仕事を抱えている。
「これ以上できません」で諦める事もできるけど、会社からの信用どころか、自分で自分の信用をなくしてしまう。
なんとかしなければ。
月曜日会社に行ったら上司と今後の進め方について相談してみよう。

コロ子、夜中の東京で迷走

セラエノさんのプレゼンの後、@etau0422さんのGASの活用法、その後3名のLTがどれも最高に面白くて大満足の定例会だった。
その後懇親会で楽しくお酒を飲み、コロ子遠方の為、みんなより先に帰ることに。
「今どこにいるんだろ～」とまったく位置を把握していないまま、Googleマップを見ながら、適当に歩き出した。しばらくすると地下鉄の入り口らしきものが見えたので入ろうとしたら、思っていた駅の名前と違う。マップを見たら全然反対方向の駅だった。マップ見てたはずなのにおかしいなー。（この時点で縮尺がおかしい。目的の駅はもっと遠い）とまた反対方向に歩いて行った。マップ見てるはずなのに横断歩道を渡ったら方向が分からなくなり行ったり来たり。途中で思っていたより距離がある事に気づき、駅まで何分かかるんだろう、終電大丈夫かなぁ、タクシー乗っちゃおうかな、などとちょっと焦ってきた。
なんとかマップで目的の駅のところまで来たのに、地下鉄の入り口が見つからない。そのまままっすぐ歩くと、マップでは駅を通りすぎている。慌てて戻ると、また駅を通りすぎている。「電車の駅が見つからないよー」と半泣きしながら近くの人に聞いたら、そっちですよ、と今来た方向を教えられ戻る。また別の人に聞いたら、「何線？あーそれだったら、その看板の横に階段があるからそこから入れるよ」と教えてもらい、なんとか電車に乗る事ができた。
駅ってどこにも書いてなかったよ！？難易度高すぎ！！！

後で分かった事だけど、最初に見つけた駅から電車に乗って1駅でコロ子の探していた駅に着くことが判明！

夜中に無駄に迷走

モジュールレベル変数（コロ子勘違いしていた）

VBA

こんにちは。
派犬事務員のコロ子です。

前回記事で自動採番のマクロを作成。
データの保持が上手くできず、空いているセルに仮置きする方法で作成した。
何かもっと良い方法はないのかなぁ～と聞いてみたところ、空腹おやじ(id:Z1000S)さんからこんな方法が！！↓　(素晴らしいので必見)

z1000s.hatenablog.com


コードを見て「えっつ！」と。コロ子が空いているセルに仮置きしたデータをモジュールレベル変数に入れている。？？？と思い実際やってみたところ、コロ子ずっと勘違いしてた事が判明。（注）低レベルです。

モジュールレベル変数

何を勘違いしていたかというと、一つのプロシージャが終了したら「全ての変数が破棄される」と思っていた。

【モジュールレベル変数】
変数をモジュールの最上部で、どこのプロシージャにも属さないで宣言すると、プロシージャ間で共有して使用できる。

Private buf As Long
’****************************************
Sub test1()

End Sub
’****************************************
Sub test2()

End Sub

この場合だと、変数「buf」はプロシージャ「test1」と「test2」で共有して使用できる。

ここまでは、コロ子も認識していた。


【コロ子の勘違い】

Private buf As Long
’****************************************
Sub test1()

buf = 1

End Sub
’****************************************
Sub test2()

Debug.Print buf

End Sub

上記の場合で
①「test1」を実行する
②「test2」を実行する
一つのプロシージャが終了したら「全ての変数が破棄される」と思っていたので、この場合「test2」の「buf」には「初期値の0」が入っていると思っていた。

実際は値は保持されていて
「test2」の「buf」には「1」が入っている。

えーーーー！そうなの？
コロ子ずーっと勘違いしてた。

そうとは知らず、今までかなりムダに苦戦してきた。
これができるとなるとコードの書き方の考え方が変わる。
目から鱗！！

ちなみに、今までどうやってモジュールレベル変数を使っていたかというと

Private buf1 As Long
Private buf2 As Long
’****************************************
Sub test1()

buf1 = 1
buf2 = 2
Call test2

End Sub
’****************************************
Sub test2()

buf1 = 10
Call test3

End Sub
’****************************************
Sub test3()

Debug.Print buf1
Debug.Print buf2

End Sub

引数を渡すのが面倒なとき。
「test2」で「buf2」は必要ないけど、「test2」で呼び出してる「test3」では「buf1」も「buf2」も必要なとき。
引数がたくさんあって、受け渡しがごちゃごちゃのときに使う物だと思っていた。
もしかしたらこの考え方も違うのかも・・・。

今回、空腹おやじさんに教えてもらわなかったら、この先もずーーーっと勘違いしたままだった。本当に、本当に感謝です。
ありがとうございました。

Worksheet_ChangeイベントとWorksheet_SelectionChangeイベント（前回の種目の自動採番コード変更しました）

VBA

こんにちは。
派犬事務員のコロ子です。

前回の記事、種目別の自動採番のコードで
空腹おやじ(id:Z1000S)さんより、

この処理だと、登録済みのA列のセルで、B列の値が最大値ではない行でF2を押して編集状態にして、そのまま何も変えないでEnter押しちゃうと、B列の値が更新されちゃいますが、大丈夫ですか？（F2、Escだと大丈夫ですが）

とご指摘頂きました。
おおっつ！ヤバイ！大丈夫じゃない！
そこまで考えが至らなかった。

下記の図のように、もうすでに値が入っているA列を編集状態にする。

f:id:SNegishi:20190814105224p:plain

　　　　↓

値を変更しないで確定すると最大値＋1を採番してしまう。
f:id:SNegishi:20190814105258p:plain

これは良くない！！重大なバグ！
実はコロ子の会社で作ったマクロはB列でダブルクリックすると採番するよういしていて、ブログ用にちょっとアレンジしたら、この有様。
（会社で問題なく使えてるから安心して！）

更新したくないのであれば、SelectionChangeイベントで、変更前の値を保持しておいて、Changeイベントで変更されているか確認する等、なんらかの処理が必要になるかも。by空腹おやじ(id:Z1000S)さん

とアドバイスいただいたので、早速作り直さなければ！


前回書いたダメなコード（コピー不可）

Private Sub Worksheet_Change(ByVal Target As Range)

Dim buf As Range

Application.ScreenUpdating = False

'1列目（A列）に変更があった時
If Target.Column = 1 Then
     
　 '初期化
    Range("B" & Target.Row).Value = ""

    'A列でフィルタ
    Range("A1").AutoFilter Field:=1, Criteria1:=Range("A" & Target.Row).Value
     
    'アクティブセル領域の可視範囲を取得
    Set buf = Range("A1").CurrentRegion.Columns(2).SpecialCells(xlCellTypeVisible)
     
    '最大値＋1を取得
    Range("B" & Target.Row).Value = Application.WorksheetFunction.Max(buf) + 1
     
    'フィルター条件解除
    ActiveSheet.ShowAllData
       
End If

Application.ScreenUpdating = True

End Sub

＊前回記事のコードは修正しました。


何がダメかというと、 Worksheet_Changeイベントについて分かっていない。

Worksheet_Changeイベント

イベントの名前が「Change」なのでセルに値や数式を入力したり、入力されているデータを変更した時に発生するイベントだと思っていた。

Changeイベントは、名前に騙されやすいので要注意です。
by空腹おやじ(id:Z1000S)さん

ところが入力されているデータを変更しなくても「編集状態」にして「確定」すると変更したとみなされ、イベントが発生してしまう。
知らなかった～。これ危険だわー。
＊「編集状態」にしてもescキーでキャンセルすればイベントは発生しない。
また、セルに色を付けたり、書式などの変更でもイベントは発生しない。

Worksheet_SelectionChangeイベント

イベントの名前の通り、選択セルが変更されたらイベントが発生する。
引数Targetに変更後のセル（カーソルがあるセル）のRangeオブジェクトが取得できる。

考え方

ChangeイベントとSelectionChangeイベントのダブル使い。
①A列のセルにカーソルが移動したら、Worksheet_SelectionChangeイベントでカーソルのあるセルの値と、の隣のB列の値を空いてるセルに仮置きする。
A列の値をAA列、B列の値をBB列に入力。
②そのセルでChangeイベントが発生したら、採番し隣のB列に値を入れる。
③もし、Changeイベント発生時のA列の値と、保存してあるAA列の値が同じ場合は、保存しているBB列の値をB列に入れる。


【コード】Worksheet_SelectionChangeイベント

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 And Target.Row >= 2 Then

    'AA列、BB列に仮置き
    Range("AA:BB").Clear
    Range("BB" & Target.Row).Value = Range("B" & Target.Row).Value
    Range("AA" & Target.Row).Value = Range("A" & Target.Row).Value

End If

End Sub


【コード】Worksheet_Changeイベント

Private Sub Worksheet_Change(ByVal Target As Range)

Dim buf As Range

Application.ScreenUpdating = False
Application.EnableEvents = False 'イベント禁止

If Target.Column = 1 Then

    'オートフィルタ
    Range("A1").AutoFilter Field:=1, Criteria1:=Range("A" & Target.Row).Value
     
    'アクティブセル領域の可視範囲を取得
    Set buf = Range("A1").CurrentRegion.Columns(2).SpecialCells(xlCellTypeVisible)
     
    '最大値＋1を取得
    Range("B" & Target.Row).Value = Application.WorksheetFunction.Max(buf) + 1
     
    'フィルター条件解除
    ActiveSheet.ShowAllData
    
    'A列に変更がない場合は元の値に戻す
    If Range("A" & Target.Row).Value = Range("AA" & Target.Row).Value Then
    
        Range("B" & Target.Row).Value = Range("BB" & Target.Row).Value
    
    End If
    
    'AA列、BB列に仮置き
    Range("AA:BB").Clear
    Range("BB" & Target.Row).Value = Range("B" & Target.Row).Value
    Range("AA" & Target.Row).Value = Range("A" & Target.Row).Value
       
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

「Worksheet_SelectionChangeイベントで変更前の値を保持しておいく」のところを静的変数Staticを使おうとしたけど、モジュール変数として使う事がでなかった。
「プローシシャーの外では使えません」のエラーメッセージが出た。
結局上手くできず、いつもの仮置き方式。
仮置き方式でないなら、どのように作るものなのでしょうか・・・？

今回は空腹おやじ(id:Z1000S)さんのアイディアをそのまま使わせて頂きました。
どうもありがとうございました！

Excel VBA 種目別に自動採番（複数の種類で連番を取る）

VBA

こんにちは。
派犬事務員のコロ子です。

種目別自動採番マクロ

コロ子の会社では毎日、品物が増えるたびに連続の番号を取る作業ある。

A列に複数の種類が入っていて、種類ごとに連番を取る。

【例】下記表で新しく種目CCCが追加になる場合。

f:id:SNegishi:20190811225617p:plain

B列に66を入力する。

f:id:SNegishi:20190811225736p:plain

もし
AAAなら：103
BBBなら：22
DDDなら：33

こんな具合に採番をする。手作業なら多分、A列の項目でフィルタをして、B列の最大値に1を足した数値を入力する。
途中で種目が変更になったり、欠番が出たり、B列の最大値が一番下に来ているとは限らない場合があるので地味に面倒な作業だったりする。

こんな作業を毎日やっているならば、マクロを作成しよう。

コピペでできるよ！

作り方

【① A列に入力規則を作成する。】
（プルダウンでデータを選択できるようにする）

A列を選択した状態で、「データ」タブ→「データの入力規則」→「データの入力規則」を選択
f:id:SNegishi:20190811231447p:plain


入力の種類：「リスト」を選択
元の値：種目を半角カンマ（,）で区切って入力

f:id:SNegishi:20190811231929p:plain



【② コードをシートモジュールに書く】
対象のシート（ここではSheet1）のシートモジュールを選択する。
オブジェクトボックスで「WorkSheet」、プロシージャーボックスで「Change」を選択する。

f:id:SNegishi:20190811232923p:plain


コードウィンドウに下記コードを書く
＊Private Sub Worksheet_Change(ByVal Target As Range)はプロシージャーボックスで「Change」を選ぶと自動に表示される。
セルの中身を変更したらこのプロシージャーが呼び出される。

【コード】Worksheet_Changeイベント

Private Sub Worksheet_Change(ByVal Target As Range)

Dim buf As Range

Application.ScreenUpdating = False
Application.EnableEvents = False 'イベント禁止

If Target.Column = 1 Then

    'オートフィルタ
    Range("A1").AutoFilter Field:=1, Criteria1:=Range("A" & Target.Row).Value
     
    'アクティブセル領域の可視範囲を取得
    Set buf = Range("A1").CurrentRegion.Columns(2).SpecialCells(xlCellTypeVisible)
     
    '最大値＋1を取得
    Range("B" & Target.Row).Value = Application.WorksheetFunction.Max(buf) + 1
     
    'フィルター条件解除
    ActiveSheet.ShowAllData
    
    'A列に変更がない場合は元の値に戻す
    If Range("A" & Target.Row).Value = Range("AA" & Target.Row).Value Then
    
        Range("B" & Target.Row).Value = Range("BB" & Target.Row).Value
    
    End If
    
    'AA列、BB列に仮置き
    Range("AA:BB").Clear
    Range("BB" & Target.Row).Value = Range("B" & Target.Row).Value
    Range("AA" & Target.Row).Value = Range("A" & Target.Row).Value
       
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


同様にプロシージャーボックスで「SelectionChange」を選択し、下記のコードを書く。
（登録済みのA列を編集状態にして、変更しないでEnter押した場合、値が変更されるのを防ぐため）
【コード】Worksheet_SelectionChangeイベント

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 1 And Target.Row >= 2 Then

    'AA列、BB列に仮置き
    Range("AA:BB").Clear
    Range("BB" & Target.Row).Value = Range("B" & Target.Row).Value
    Range("AA" & Target.Row).Value = Range("A" & Target.Row).Value

End If

End Sub

＊空腹おやじ(id:Z1000S)さんよりご指摘頂いて修正しました。
詳しくは次の記事で。


完成！

例えば、A列に日付、B列に種目、C列に番号の表の場合、コードの

”A”→”B”
”B”→”C”
”A1”→”B1”
4行目のTarget.Column = 1　→　Target.Column = 2（数字は列の番号）

に変更すればOK！
こんな作業のある人は自分の表に合わせて作ってみよう！


このマクロ、VBAを始めたての頃に「マクロの自動記録」で作成した。
もちろんそのままでは使えないから、上手くいかないところを無理やり手で直して、何がなんだか分からないけど、とりあえず希望の結果になるからOKという作り方だった。
それから毎日このマクロを使っていて、特に問題ないからずっとそのままにしてたけど、最近見直したら、あまりにもヒドイ驚きのコードだったので作り直すことにした。マクロの自動記録をベースにしてるからコードがやたらと長くて意味不明の個所がいっぱいあった。

そんなデタラメでも、出来た時は感動したし、すごく便利で重宝しているから、下手でも力ずくでも作って良かっな、って思う。そして、その時の感動が「VBAでもっといろいろできるようになりたい！」という気持ちの源だったんだな、と実感。

マンゴー杯！

VBA

こんにちは。
派犬事務員のコロ子です。

マンゴー杯　結果報告

前回、あみだくじや抽選のコードを「自分ならこう書く！」を募集したところ、素晴らしいアイディアの応募がありました！どうもありがとうございます！！
みんな演出が凝っていて高度な技が満載！

エントリーNo.１

セラエノ (id:celaeno42)さん
celaeno42.hatenablog.com

エントリーNo.２

id:Infomentさん
infoment.hatenablog.com

さらに進化版。あみだくじの格子部分もマクロで作る↓
infoment.hatenablog.com

infoment.hatenablog.com

すごい！！！
あみだくじの完成形。必見↓
infoment.hatenablog.com

あみだくじファイナル↓
infoment.hatenablog.com


エントリーNo.3

Kou (id:ExcelLover)さん
www.excellovers.com

エントリーNo.4

コロ子
ちょっとみんな凄すぎて実力の差がありすぎる・・・。
こうなったらコロ子が絶対当たるマクロを作ろう。

【コロ子が絶対当たる抽選】
マンゴーの数を入力して「抽選」ボタンを押すと、「当たり」「はずれ」が表示される。コロ子は絶対「当たり」が出る。
f:id:SNegishi:20190804231401p:plain


【考え方】
①「当たり・はずれの要素」「乱数を入れる要素」を加者数-1（コロ子を抜かす）の要素数の2次元配列を用意する。
②「当たり・はずれの要素」の先頭から、マンゴーの数-1個の当たり、後ははずれを入れる。
③「乱数を入れる要素」に整数1～参加者数を重複しないでランダムに入れる。

例：マンゴーの数3個、コロ子以外の参加者7人の場合の配列のイメージ

f:id:SNegishi:20190804215251p:plain
配列のイメージ

④「乱数を入れる要素」で昇順にソートする。

⑤結果セルに「乱数を入れる要素」を順に入れていく。
このとき参加者が「コロ子」だったら当たりを入れスキップし、次のセルへ。

【コード】
抽選ボタン

Sub Absolutely_win()

Dim i As Long, j As Long
Dim StartCell As Long
Dim Cellcount As Long
Dim Arr() As Variant

Application.ScreenUpdating = False

StartCell = 5
Cellcount = Cells(Rows.Count, 1).End(xlUp).Row - StartCell

ReDim Arr(1 To Cellcount, 1)

For i = 1 To Cellcount

    If i < Range("B2").Value Then
        Arr(i, 0) = "当たり"
    Else
        Arr(i, 0) = "はずれ"
    End If

    Dim Flg() As Boolean
    ReDim Flg(1 To Cellcount)
    Dim Num As Long
    
    '整数1～参加者数を重複しないでランダムに発生させる
    Randomize
    Do
        Num = Int((Cellcount - 1 + 1) * Rnd + 1)
    Loop Until Flg(Num) = False
    Arr(i, 1) = Num
    Flg(Num) = True
    
Next i

'ソート
Call ArrSort(Arr)

'セルに配列を入れる（コロ子の時は当たりを入れる）
For i = 1 To Cellcount

    Cells(StartCell, 2).Value = Arr(i, 0)
    
    If Cells(StartCell, 1).Value = "コロ子" Then  
        Cells(StartCell, 2).Value = "当たり"
        i = i - 1
    End If

    StartCell = StartCell + 1
    
Next i

Application.ScreenUpdating = True

End Sub

※範囲を指定して乱数を発生させる
乱数=Int((最大値 - 最小値 +1 ) * Rnd + 最小値)


配列をソートする

Sub ArrSort(Arr As Variant)

Dim bufL As Long
Dim bufS As String
Dim i As Double
Dim j As Double

For i = UBound(Arr, 1) To LBound(Arr, 1) Step -1

    For j = LBound(Arr, 1) To i - 1
    
        If Arr(j, 1) > Arr(j + 1, 1) Then
        
                bufS = Arr(j, 0)
                bufL = Arr(j, 1)
                
                Arr(j, 0) = Arr(j + 1, 0)
                Arr(j, 1) = Arr(j + 1, 1)
                
                Arr(j + 1, 0) = bufS
                Arr(j + 1, 1) = bufL
                                
        End If
        
    Next j
    
Next i

やったー！コロ子マンゴー当たったー！！
セコイ！！
こーゆー不正はダメですよ！



【今回のポイント】
整数1～参加者数を重複しないでランダムに発生させる

For i = 1 To Cellcount
・
・
・
    Dim Flg() As Boolean
    ReDim Flg(1 To Cellcount)
    Dim Num As Long

    Randomize
    Do
        Num = Int((Cellcount - 1 + 1) * Rnd + 1)
    Loop Until Flg(Num) = False

    Arr(i, 1) = Num
    Flg(Num) = True

Next i

Boolean型の初期値はFalse

範囲を指定して乱数を発生させてみたら、意外と多く重複していた。
重複しないように作ろうとしたところ、なかなか上手かず、ネットで調べたら
Boolean型の配列を使うというのがあった。
最初Do～Loopのところだけを見て？って思ったけど、その下の
Arr(i, 1) = Num
Flg(Num) = True
を見て納得！Boolean型の初期値はFalse。Numを配列に格納したらFlgの要素数Num番目をTrueにすれば、ループでフラグの要素数Num番目がTrueだったら重複しているので、重複しなくなるまで乱数を発生させる。
こんなフラグの使い方あるんだ！

参考サイト
www.moug.net