VBAを使ってロト6のデータを形にする その2
はじめに
前回、
vba-belle-equipe.hatenablog.com
本数字の当り回数を43の数字それぞれでカウントし、表示するところまでいきました。
今回は「ボーナス数字」と「連続ハズレ回数」を出してみます。
コード
こんな感じになりました。
Sub 更新() Dim startnum As Long, endnum As Long Dim i As Long, j As Long Dim hit(1 To 43) As Long Dim bonus(1 To 43) As Long Dim nohit(1 To 43) As Long Dim num As Long With Sheets("メイン") startnum = .Range("C1") endnum = .Range("C2") .Range("C3") = endnum - startnum + 1 End With With Sheets("結果") For i = startnum + 1 To endnum + 1 '連続ハズレ For j = 1 To 43 nohit(j) = nohit(j) + 1 Next '本数字 For j = 2 To 7 num = .Cells(i, j) hit(num) = hit(num) + 1 nohit(num) = 0 'ハズレリセット Next j 'ボーナス数字 num = .Cells(i, 8) bonus(num) = bonus(num) + 1 Next i End With For i = 6 To 48 Cells(i, 3) = hit(i - 5) Cells(i, 4) = bonus(i - 5) Cells(i, 5) = nohit(i - 5) Next End Sub
ボーナス数字
単純に
Dim bonus(1 To 43) As Long
と新しい配列を作って、カウントしています。
連続ハズレ回数
こちらは
Dim nohit(1 To 43) As Long
という配列を作り
- For文の「i」が増える(= 「回」を重ねる)ごとに連続ハズレ回数が1回ずつ増えていく
- ただし、当たったらその数字のカウントはゼロになる
というふうにしています。
結果
こんな感じです。
27回連続とか、なかなかハズレとんなという感じですが、どうなんでしょうか。
その辺の統計を次回はとってみたいと思います。
VBAを使ってロト6のデータを形にする その1
はじめに
先日、新人個人事業主として、税務署主催の青色申告説明会というものに行ってきました。
大変暇な思索にふける時間に富んだ内容でしたので、以前知人から相談された内容についてずっと考えてました。
それは
VBAを使ってロト6を当てられないのか
ムリでしょ
というもの。
どういう情報をどうやって取るかなーと考えるのは結構面白いです。
どんなデータをとるか
とりあえず統計的に意味がありそうな
- それぞれの数字の当選回数
- どれだけ連続で外れているか
あたりをやってみましょう。
「結果」シート
6個の当り数字、ボーナス数字を一覧にしたシートです。
「メイン」シート
対象の回範囲を設定して、それぞれの数字の当り回数を表示させます。
書いてみる
コード
実際に書いて実行してみます。
Sub 更新() Dim startnum As Long, endnum As Long Dim i As Long, j As Long Dim hit(1 To 43) As Long Dim num As Long With Sheets("メイン") startnum = .Range("C1") endnum = .Range("C2") .Range("C3") = endnum - startnum + 1 End With With Sheets("結果") For i = startnum + 1 To endnum + 1 For j = 2 To 7 num = .Cells(i, j) hit(num) = hit(num) + 1 Next j Next i End With With Sheets("メイン") For i = 6 To 48 .Cells(i, 3) = hit(i - 5) Next End With End Sub
ポイント
43個の数字の結果をそれぞれカウントしたいので、配列を
Dim hit(1 To 43) As Long
で作っています。
これにより、1の結果は「hit(1)」、43の結果は「hit(43)」でOK!
結果
こんな感じで、1から43までの当り回数をカウントできました。
※ウインドウ枠を固定しているので、一部が表示されています
「Office 365 サービス の利用開始手続き完了のお知らせ」 というメール
ある日
2016年×月××日に [Office 365 サービス] のご利用開始手続きが完了しました。サービスの詳しい内容については、こちらをご覧ください。
これは、1 年契約の Office Premium PIPC 向け Office 365 サービス サブスクリプションです。有効期限が切れる前に、サブスクリプションの更新を促すメールがお客様に送信されます。www.Office.com/myaccount にサインインすると、アカウントを管理したり、サブスクリプションに含まれている OneDrive や Skype などのサービスにアクセスすることができます。
http://www.office.com/myaccount/ にアクセスして Office をインストールします。
ありがとうございます。
Microsoft Office チーム
注意: このメールは配信専用のアドレスからお送りしています。このメールにご返信いただいても、お問い合わせにお答えすることはできませんので、あらかじめご了承ください。
アカウントの課金情報の詳細 (該当する場合) については、http://commerce.microsoft.com/ にアクセスしてください。プライバシーに関して不明な点がある場合は、http://privacy.microsoft.com/ にアクセスしてください。
というメールが来ていました。
イタズラかなと思いながら、リンクは押さずにMiceosoftのアカウントを見たら、一応本物っぽい。
(2017年△月△日にサブスクリプションの有効期限が切れますと書いてあった)
新しいPCのOfficeを有効化した時に何かしたんだったっけかな。
半年?くらい経ってるから覚えてないですね。
(昨日でも覚えていないかもしれないが)
それにしても、いきなり「ご利用開始手続きが完了しました」って、ギョッとしますな。
セル上の英文を読み上げてもらう
はじめに
ネタができたらVBAの記事書こうと思っていたら、なかなかに久々になりました。
ネタって自然と湧き出てくるわけではないんですね。
やりたいこと
Excelのセル上の英語テキストを読ませたい
とりあえずやってみよう
まずはExcelの標準でできないかどうか、Google先生にお伺いをたてます。
「Excel」「VBA」「読み上げ」「音声」などを組み合わせて検索。
さすがにできないだろと思うことも、とりあえず訊くが吉です。
セルの読み上げ機能
こちらのページに「セルの読み上げ機能」というものがあり、「あれ? 終わった」と思いました。
が、これを実際に試してみると、なかなか面白いレベル。
昔の読み上げってこんな感じだったなあという。
Office TANAKA - Excel VBA Tips[テキストファイルを読み上げる]
VBAでもできるようです。
が、もう少しうまく読んでもらえるか調べてみましょう。
SAPI?
VocExcel / SAPI で読み上げ / エクセル マクロ
よくわかりませんが、SAPIというものを使う方法が書いてありました。
試しに
Sub 読み上げテスト() Dim Voice1 Set Voice1 = CreateObject("SAPI.SpVoice") Set Voice1.Voice = Voice1.GetVoices().Item(0) Voice1.Speak "Hello world" End Sub
上の方法と変わらない?
しかし「読み上げる人物が変る」という情報がありましたので
声のタイプを取得してみると
Sub 声タイプゲット() Dim Voice1 Dim cnt As Long Dim i As Long Set Voice1 = CreateObject("SAPI.SpVoice") cnt = Voice1.GetVoices.Count For i = 0 To cnt - 1 Set Voice1.Voice = Voice1.GetVoices().Item(i) Debug.Print Voice1.Voice.GetDescription() Next i End Sub
実行すると、イミディエイトウインドウに
Microsoft Haruka Desktop - Japanese Microsoft Zira Desktop - English (United States)
こんな感じで、表示されます。*1
Englishバージョンがある!
Ziraというのは名前でしょうか。
Voice1.GetVoices().Item(1)にして試したら、無事に英語っぽく読んでくれました。
ヤッタネ!!
選択セルを読んでもらう
ここまできたら、あとは簡単ですね。
Sub 読み上げ() Dim Voice1 Dim cnt As Long Dim r As Range Dim str As String Set Voice1 = CreateObject("SAPI.SpVoice") Set Voice1.Voice = Voice1.GetVoices().Item(1) For Each r In Selection str = r.Value If str <> "" Then Voice1.Speak str End If Next End Sub
クイックアクセスツールバーに追加
どうせなら、セルの読み上げ機能と同じように、クイックアクセスツールバーに追加したいところですね。
Excelマクロ/VBAで始める業務自動化プログラミング入門(1):Excelでプログラム作成を始めるメリットとマクロの基本 (3/5) - @IT
こちらにやり方が書いてあります。
アイコンや表示名は、変更ボタンから変えられます。
とりあえず再生アイコンにしてみました。
セルを選択 -> アイコン押す で、Ziraさんが英語を読み上げてくれます。
*1:Windows10。環境によって違うと思われます