'=========================================================================================
' 234 Ifをセルに入れて条件判定する
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim 下端 As Long                                '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Private Sub Ifをセルに入れて条件判定する()      '★★★
    Range("C2").Formula = "=IF(A2="""","""",RIGHT(A2,LEN(A2)-FIND("" "",A2,1)))"
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 数式を複写する()                    '★★★
    Worksheets("取り出し").Range("C2").Copy     'コピーする
    Worksheets("取り出し").Range("D2").PasteSpecial Paste:=xlFormulas '数式を貼り付ける
    下端 = 100
    Worksheets("取り出し").Range("C2:D2").Copy
    Worksheets("取り出し").Range(Cells(2, 3), Cells(下端, 4)).PasteSpecial Paste:=xlFormulas
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    おためし画面を表示する
    動作説明1を表示する
    動作説明2を表示する
    元シートのデータを取り出しシートへ写す
    動作説明3を表示する
    Ifをセルに入れて条件判定する                '★★★
    動作説明4を表示する
    数式を複写する                              '★★★
    動作説明5を表示する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためし画面を表示する()
    Worksheets("取り出し").Select
        Cells.Clear          'クリアする
        Columns("A:D").Select
        Selection.ColumnWidth = 8.38
    Worksheets("Title").Select
        Range("P17").Select                    'カーソルを定位置へ移動する
    タイトル = "500連発 第2弾 サンプルマクロ"
    スタイル = 64                               'vbInformation
    おためし用に画面でシートを一望できるようにする
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためし用に画面でシートを一望できるようにする()
    ActiveWindow.WindowState = xlMaximized      'ウィンドウを最大化する
    Sheets("取り出し").Select
        ActiveWindow.NewWindow                  '新しいウィンドウを開く
    Sheets("元データ").Select
    Windows.Arrange ArrangeStyle:=xlVertical    'ウィンドウを左右に並べて表示する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 動作説明1を表示する()
    Windows("234.XLS:2").Activate
    メッセージ = "左側の「元データ」シートの A、B列のそれぞれに、" & Chr(13) & Chr(13) & _
                "スペースで区切られた種別と番号が入っています"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
'
    Windows("234.XLS:1").Activate
    Range("A1").Select
    メッセージ = "右側の「取り出し」シートには、" & Chr(13) & Chr(13) & _
                "今は何も入っていません"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
'
    Range("A1").Value = "元データのA列より"
    Range("B1").Value = "元データのB列より"
    Range("C1").Value = "A列から取り出した番号"
    Range("D1").Value = "B列から取り出した番号"
    Columns("A:D").Font.Size = 9
    Columns("A:D").EntireColumn.AutoFit
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 動作説明2を表示する()
    Windows("234.XLS:2").Activate
    Columns("A:B").Select
    下端 = Worksheets("元データ").Range("A1").End(xlDown).Row '元シートの下端セルの行番号を取得
    メッセージ = "「元データ」の A、B列のデータをコピーして、" & Chr(13) & _
                "「取り出し」シートに貼り付けます"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 元シートのデータを取り出しシートへ写す()
    Sheets("元データ").Range(Cells(2, 1), Cells(下端, 2)).Copy _
        Destination:=Sheets("取り出し").Range("A2")
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 動作説明3を表示する()
    Windows("234.XLS:1").Activate
    Range("C2").Select
    メッセージ = "「取り出し」シートの C2セルに、" & Chr(13) & Chr(13) & _
                "A列のデータの何文字目にスペースがあるかを調べて番号部分を取り出す、" & Chr(13) & _
                "IF関数を含む数式をセットします"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 動作説明4を表示する()
    メッセージ = "C2セルをコピーして、D2セルに数式を貼り付けます。" & Chr(13) & Chr(13) & _
                "そして、C2:D2セルをコピーして、下方向に 100行貼り付けます"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 動作説明5を表示する()
    Windows("234.XLS:1").Activate
    Range(Cells(2, 3), Cells(下端, 4)).Select
    メッセージ = "IF関数により、データがある行だけ番号部分が取り出されています。" & _
                Chr(13) & Chr(13) & "画面を元へ戻します"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
    Windows("234.XLS:2").Close
    Worksheets("Title").Activate
    ActiveWindow.WindowState = xlMaximized
        Range("P17").Select
        ActiveWindow.FreezePanes = True
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------