'=========================================================================================
' 305 特定の文字列が何個存在するか調査する
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim 特定文字列 As String                        '★★★
Dim 特定長さ As Integer                         '★★★
Dim 文字列 As String                            '★★★
Dim 文字列長さ As Integer                       '★★★
Dim 下端 As Long                                '★★★
Dim 先端 As Long                                '★★★
Dim 行 As Long                                  '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Sub 特定の文字列が何個存在するか調査する()      '★★★
    Sheets("調査表").Select                             '※１
        下端 = Range("A1").End(xlDown).Row              '下端検出
        Range(Cells(2, 2), Cells(下端, 2)).Value = 0    '調査結果を一旦ゼロにする
        Cells(2, 6) = ""                                '答えをクリア
        特定文字列 = Cells(2, 4)                        '特定の文字列を取り出す
        特定長さ = Len(特定文字列)                       '      〃    の長さを調べる
        For 行 = 2 To 下端                              '下端行まで反復する
            文字列 = Cells(行, 1)                       '文字列を取り出す
            文字列長さ = Len(文字列)                    '文字列の長さを調べる
            先端 = 1                                    '文字列の先端
比較:
            If 文字列長さ >= 特定長さ Then              '文字列は特定文字列より長いか
                If 特定文字列 = Mid(文字列, 先端, 特定長さ) Then '特定文字列と文字列の一部が一致するか
                    Cells(行, 2) = 1                    '調査結果を1にする
                    Cells(2, 6) = Cells(2, 6) + 1       '存在個数に1加える
                    GoTo 次へ
                End If
                文字列長さ = 文字列長さ - 1             '文字列長さを1字減らす
                先端 = 先端 + 1                         '次の文字を指し示す
            GoTo 比較
            End If
次へ:
        Next
        Range("F2").Select
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    おためしメッセージを表示する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    Worksheets("調査表").Select
    Range("D2").ClearContents                   'クリアする
    Range("D2").Select                          'カーソルを定位置へ移動する
    タイトル = "500連発 第2弾 サンプルマクロ"
    スタイル = 64                               'vbInformation
    メッセージ = "A列の中の調査したい文字列を、赤色セルに入力してから、" & Chr(13) & Chr(13) & _
                "［調査開始］ボタンをクリックしてください"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------