#はじめに
この記事は「大石泉すき」Advent Calendar 2019への参加記事です。
この記事はプログラミング初心者の方向けに作成しております。また、私も業務として開発経験のないにわかプログラマで、この記事も自身の勉強と復習を兼ねているため、間違った記述があるかと思われます。その際はどうぞご指摘ください。

#Excel VBAとは
Excel VBAとは、文字通りMicrosoft社の表計算ソフト「Excel」で使用できるプログラミング言語です。ExcelがインストールされていればどんなPCでも開発することができるため開発環境を整える必要がなく、プログラミング初心者が開発に慣れるため取り組むのに向いているのではないでしょうか。また、ご自身の会社でExcelを使用した業務の効率化を図ることもできます。

#今回の目標
今回はタイトルの通り、「大石泉すき」から1文字を縦のセルにランダムに出力し続け、「大石泉すき」が揃うまで何文字かかったかというゲームのようなものをつくり、Excelシート上に実装します。

画像の通りA1セルにはタイトルを入力するため、A2セルからスタートします。

#コードと解説
今回実装したコード全体は以下の通りです。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long
    Dim suki As String

    Const izumi As String = "大石泉すき"
    
    Application.ScreenUpdating = False
    
    r = 2
    
    Do Until suki = "大石泉すき"
        suki = ""

        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char

        If r >= 6 Then
            suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1)
        End If
        
        r = r + 1
    Loop
    
    MsgBox "大石泉すきまで" & r - 2 & "文字かかりました。"
    
    Application.Goto Reference:=Cells(r - 5, 1), Scroll:=True
    Cells(r - 1, 1).Select
    
    Application.ScreenUpdating = True
End Sub

以下、

「大石泉すき」のうちランダムに1文字をひとつのセルに出力する。
A2、A3、A4…と縦に繰り返し出力していき、「大石泉すき」が揃ったら動作を終了する。
揃うまでに何文字かかったかを通知する。

という順で解説していきます。

1. 「大石泉すき」のうちランダムに1文字をひとつのセルに出力する。

処理の順序は
① 抽出元の文字列(「大石泉すき」)を定義する
② 何文字目を抽出するかを決めるため、1〜5の整数をランダムに出力する
③ ①で定義した文字列から②で出力した数字の位置にある文字を抽出
④ 抽出した文字をセルに代入
となります。

① 抽出元の文字列(「大石泉すき」)を定義する

最初に、1文字を抽出するための元となる「大石泉すき」という定数を定義します。
プロシージャ名を「OhishiIzumiSuki」とし、定数「izumi」をString型で定義、そこに文字列「大石泉すき」を格納します。

Sub OhishiIzumiSuki()
    '① 抽出元の文字列(「大石泉すき」)を定義する
    Const izumi As String = "大石泉すき"
End Sub

② 何文字目を抽出するかを決めるため、1〜5の整数をランダムに出力する

これには指定した最小値から最大値までの整数の乱数を生成するRandBetween関数というExcel関数を利用します。WorksheetFunctionプロパティを利用し、Excelの関数を呼び出します。

次に、RandBetween関数により生成された乱数を変数に格納します。格納する変数名を「location」として宣言し、型をInteger型と指定します。この処理をOhishiIzumiSukiプロシージャで定義した定数の後ろに組み込んであげます。

Sub OhishiIzumiSuki()
    '① 抽出元の文字列(「大石泉すき」)を定義する
    Const izumi As String = "大石泉すき"

    '②何文字目を抽出するかを決めるため、1〜5の整数をランダムに出力する
    Dim location As Integer
    location = WorksheetFunction.RandBetween(1, 5)
End Sub

余談ですが、実はExcelとExcel VBAの関数はすべて共通しているわけではなく、Excelで使用できる関数もExcel VBAでは使用できないことがあります。このRandBetween関数もそのひとつです。Excel VBAで使用できる関数のみで範囲指定の乱数を生成する方法もありますが、今回は手軽なRandBetween関数を使います。

③ ①で定義した文字列から②で出力した数字の位置にある文字を抽出

これにはMid関数を使用します。Excelでもおなじみの関数ですね。こちらはWorksheetFunctionプロパティなしで使用できます。

「大石泉すき」のうちランダムに出力された1文字を格納する変数を「rand_char」(Random Characterの略)とし、String型で宣言します。Mid関数においては、対象文字列を定数「izumi」、開始位置を変数「location」、抽出する文字数を「1」とし、それを変数「rand_char」に格納します。

Sub OhishiIzumiSuki()
    '① 抽出元の文字列(「大石泉すき」)を定義する
    Const izumi As String = "大石泉すき"

    '②何文字目を抽出するかを決めるため、1〜5の整数をランダムに出力する
    Dim location As Integer
    location = WorksheetFunction.RandBetween(1, 5)

    '③ ①で定義した文字列から②で出力した数字の位置にある文字を抽出
    Dim rand_char As String
    rand_char = Mid(izumi, location, 1)
End Sub

④ 抽出した文字をセルに代入

最後に、出力された変数「rand_char」をExcelシートのセルに代入します。VBAでセルは「Cells(行インデックス, 列インデックス)」で指定できます。今はとりあえず、先頭のセルであるA2セルに代入するというかたちで進めます。

Sub OhishiIzumiSuki()
    '① 抽出元の文字列(「大石泉すき」)を定義する
    Const izumi As String = "大石泉すき"

    '②何文字目を抽出するかを決めるため、1〜5の整数をランダムに出力する
    Dim location As Integer
    location = WorksheetFunction.RandBetween(1, 5)

    '③ ①で定義した文字列から②で出力した数字の位置にある文字を抽出
    Dim rand_char As String
    rand_char = Mid(izumi, location, 1)

    '④ 抽出した文字をセルに代入
    Cells(2, 1) = rand_char
End Sub

これでも十分プログラムは動きますが、可読性にやや難があるので、少し整理します。

Sub OhishiIzumiSuki()
    '変数部分
    Dim location As Integer
    Dim rand_char As String

    '定数部分
    Const izumi As String = "大石泉すき"

    '定数からランダムに1文字を抽出する部分
    location = WorksheetFunction.RandBetween(1, 5)
    rand_char = Mid(izumi, location, 1)

    'セルに代入する部分
    Cells(2, 1) = rand_char
End Sub

以上で「大石泉すき」からランダムで１文字をセルに出力する部分が完成しました。

2. 縦に繰り返し出力していき、「大石泉すき」が揃ったら動作を終了する。

次に動作の繰り返しと終了の条件を設定します。
Excel VBAには繰り返しの処理をするための構文がいくつか存在しますが、今回は条件式を満たすまで繰り返し処理を続けるという「Do Until〜Loop文」という構文を使用します。

先程つくったプロシージャの中身をそのままDo Until〜Loop文で挟んでしまっても問題ありませんが、繰り返す必要のない変数の宣言と定数の定義は、繰り返し構文の前に出してあげるのが一般的です。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String

    Const izumi As String = "大石泉すき"

    Do Until 条件式
        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(2, 1) = rand_char
    Loop
End Sub

上記のコードの場合、条件式を満たすまでひたすらA2セルに文字を代入し続けます。
ですが、今回実装したい機能はA2、A3、A4…と縦に順に入力し続ける必要があるため、現在指定しているセルの行部分を変数に置き換えて、代入した直後のセルに入力を繰り返すよう変更します。
セルの行を定める変数を「r」とし、Long型で宣言します。入力するセルを下げていく必要があるため、変数「r」の初期値を2とし、繰り返すたびに1を足していく計算式を追加します。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long '追加部分

    Const izumi As String = "大石泉すき"

    r = 2 '追加部分

    Do Until 条件式
        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char '変更部分

        r = r + 1 '追加部分
    Loop
End Sub

これで条件式を満たすまでA2、A3、A4…と「大石泉すき」のうちランダムに1文字を入力する繰り返しのプログラムができました。

次に条件式です。
まずは入力されたセルとその直前4つのセル、計5つのセルを変数に格納します。変数「suki」をString型で宣言し、5つのセルを&でつなげイコールで結ぶだけです。

Dim suki As String
suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1)

上記をセルの代入部分の下部に、またUntilの後ろに変数「suki」が「大石泉すき」となった場合の条件式を追加します。ループの先頭で変数をリセットするのも忘れないようにしましょう。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long
    Dim suki As String '追加部分

    Const izumi As String = "大石泉すき"

    r = 2

    Do Until suki = "大石泉すき" '変更部分
        suki = "" '追加部分

        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char

        suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1) '追加部分

        r = r + 1
    Loop
End Sub

ただ、実はこのままだとプログラムはうまく作動しません。なぜならr<5のとき、変数「suki」に格納されるセルの行インデックスが1未満になってしまい、セルを取得できないためです。なので、今回はA2から下のセルに文字を入力していくことを考慮して、変数「r」が6以上のときのみセルを変数「suki」に格納していくようにします。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long
    Dim suki As String

    Const izumi As String = "大石泉すき"

    r = 2

    Do Until suki = "大石泉すき"
        suki = ""

        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char

        If r >= 6 Then '追加部分
            suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1)
        End If '追加部分

        r = r + 1
    Loop
End Sub

3.揃うまでに何文字かかったかを通知する。

最後に、MsgBox関数を利用し「大石泉すき」が揃うまで何文字かかったかを通知します。
繰り返し終了直前に1を足した分と、A2セルからスタートしている部分を考慮し、変数「r」から2を引いておきます。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long
    Dim suki As String

    Const izumi As String = "大石泉すき"

    r = 2

    Do Until suki = "大石泉すき"
        suki = ""

        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char

        If r >= 6 Then
            suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1)
        End If

        r = r + 1
    Loop

    MsgBox "大石泉すきまで" & r - 2 & "文字かかりました。" '追加部分
End Sub

あとはお好みですが、「大石泉すき」が揃ったところまでスクロールするGotoメソッドと、末尾のセルを選択するSelectメソッドを追加すると、結果がきれいに表示されてよいと思います。
さらに必要に応じて、処理中の画面更新をストップするScreenUpdatingメソッドを追加してもよいでしょう。

Sub OhishiIzumiSuki()
    Dim location As Integer
    Dim rand_char As String
    Dim r As Long
    Dim suki As String

    Const izumi As String = "大石泉すき"
    
    Application.ScreenUpdating = False
    
    r = 2
    
    Do Until suki = "大石泉すき"
        suki = ""

        location = WorksheetFunction.RandBetween(1, 5)
        rand_char = Mid(izumi, location, 1)

        Cells(r, 1) = rand_char

        If r >= 6 Then
            suki = Cells(r - 4, 1) & Cells(r - 3, 1) & Cells(r - 2, 1) & Cells(r - 1, 1) & Cells(r, 1)
        End If
        
        r = r + 1
    Loop
    
    MsgBox "大石泉すきまで" & r - 2 & "文字かかりました。"
    
    Application.Goto Reference:=Cells(r - 5, 1), Scroll:=True
    Cells(r - 1, 1).Select
    
    Application.ScreenUpdating = True
End Sub

最後に、プロシージャと紐付けたボタンをシート上に配置したり、先頭行を固定してタイトルが常に表示されるよう調整すれば完成です。

おまけ-結果をリセットするプロシージャをつくる-

出力した文字数が前回出力した文字数より少ない場合、上書きできなかったセルが残ってしまいますので、実行した結果を消去するプロシージャを作成します。
以下は、入力されているセルの最終行インデックスを取得(有名な方法ですので解説は割愛します)し、ClearContentsメソッドを利用してA2セルから最終セルまでのセルの内容を削除するというものです。また、A2以下のセルがすべて空、つまり変数「endr」が1の場合、ClearContentsメソッドの範囲がA1セル～A2セルとなり入力したタイトルを消去してしまうので、If文でこれを回避します。
メインの内容とはあまり関係ありませんが、参考程度にどうぞ。

Sub reset()
    Dim endr As Long

    'A列に入力されている最終行インデックスを取得
    endr = Cells(Rows.Count, 1).End(xlUp).Row

    If endr >= 2 Then 'A2以下のセルが空でない場合
        Range(Cells(2, 1), Cells(endr, 1)).ClearContents
        Application.Goto Reference:=Cells(2, 1), Scroll:=True
    Else 'A2以下のセルが空の場合
        MsgBox "データがありません。"
    End If
End Sub