追加課題(1/29)

月別販売データモジュール内の新規シート関数において，
月の入力で１～１２以外の入力があった場合，
処理を中断するようにせよ．

→tuki変数の値が１～１２の範囲内か否か？

Sub 新規シート()
    Dim tuki As String
    ActiveSheet.Copy after:=ActiveSheet
    Range("C6:D15,F6:F15,J6:J15").Select
    Selection.ClearContents
    Range("A1").Select
    tuki = InputBox("月を半角の数字で入力してください", "新規シート作成")
    If tuki = "" Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    Else
        If tuki < 0 Or tuki > 12 Then
            MsgBox "月は１～１２の範囲で入力してください"
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
        Else
            On Error Resume Next
            ActiveSheet.Name = tuki & "月度"
            If Err.Number = 1004 Then
                MsgBox "シート名が重複します"
                Application.DisplayAlerts = False
                ActiveSheet.Delete
                Application.DisplayAlerts = True
            End If
        End If
    End If
End Sub

追加課題(1/23)

シート「６月度」（販売一覧）の販売データを入力するプログラムにおいて，キャンセルボタンを押すことで処理を中断できるようにせよ．

Sub 入力()
    Dim hiduke As String
    ActiveWindow.NewWindow
    ActiveWindow.NewWindow
    Windows.Arrange ArrangeStyle:=xlTiled
    Windows("第6章.xlsm:2").Activate
    Sheets("得意先リスト").Select
    Windows("第6章.xlsm:1").Activate
    Sheets("商品リスト").Select
    Windows("第6章.xlsm:3").Activate
    If Range("C6").Value = "" Then
        Range("C6").Select
    Else
        Range("C5").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
    End If
    Do While ActiveCell.Offset(0, -1).Value <> ""
        
        hiduke = InputBox("日付を入力してください" & Chr(13) & "日付入力を終了する場合にはキャンセルボタンを押してください", , , 200, 200)
        If hiduke = "" Then
            MsgBox "入力をキャンセルします(1)"
            Exit Do
        Else
            ActiveCell.FormulaR1C1 = hiduke
            ActiveCell.Offset(O, 1).Range("A1").Select
                
            hiduke = InputBox("得意先コードを入力してください", , , 200, 200)
            If hiduke = "" Then
                MsgBox "入力をキャンセルします(2)"
                Exit Do
            Else
                ActiveCell.FormulaR1C1 = hiduke
                ActiveCell.Offset(O, 2).Range("A1").Select


                hiduke = InputBox("商品コードを入力してください", , , 200, 200)
                If hiduke = "" Then
                    MsgBox "入力をキャンセルします(3)"
                    Exit Do
                Else
                    ActiveCell.FormulaR1C1 = hiduke
                    ActiveCell.Offset(O, 4).Range("A1").Select

                    hiduke = InputBox("数量を入力してください", , , 200, 200)
                    If hiduke = "" Then
                        MsgBox "入力をキャンセルします(4)"
                        Exit Do
                    Else
                        ActiveCell.FormulaR1C1 = hiduke
                        ActiveCell.Offset(1, -7).Range("A1").Select
                    End If
                End If
            End If
        End If
    Loop
    Windows("第6章.xlsm:2").Activate
    ActiveWindow.Close
    Windows("第6章.xlsm:1").Activate
    ActiveWindow.Close
    ActiveWindow.WindowState = xlMaximized
End Sub

追加課題(1/16)

シート「商品リスト」において，商品を追加する際に使用する対話的なプログラムを作成せよ．
方針：InputBox関数を利用．追加課題(12/28)を参考に，商品リストの最終行に移動し，そこから入力を開始．入力したセルの周囲に罫線を引く．

１．商品リストの最終行左端に移動

Sub 商品追加()
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

２．InputBoxを実行し，ユーザーが入力した商品コードを受け取る

Dim syouhinCode As String
syouhinCode = InputBox("商品コードを入力してください", "商品追加", , 100, 100)

３．商品コードをセルに書き込む

ActiveCell.Value = syouhinCode

４．セルの周囲に罫線を引く

ActiveCell.BorderAround ColorIndex:=1

５．一つ右のセルに移動

ActiveCell.Offset(0, 1).Select

（２～５を繰り返す）

６．完成！
６－１．素直に繰り返した場合

Sub 商品追加()
    '表の最終行に移動
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
    '商品コードを入力
    Dim syouhinCode As String
    syouhinCode = InputBox("商品コードを入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '商品名を入力
    syouhinCode = InputBox("商品名を入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '色を入力
    syouhinCode = InputBox("色を入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '単価を入力
    syouhinCode = InputBox("単価を入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '輸入国を入力
    syouhinCode = InputBox("輸入国を入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '入荷状況を入力
    syouhinCode = InputBox("入荷状況を入力してください", "商品追加", , 100, 100)
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
End Sub

６－２．データの受付を最初に行い，まとめて書き込みを行う場合

Sub 商品追加()
    '表の最終行に移動
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
    
    '商品コードを受付
    Dim syouhinCode As String
    syouhinCode = InputBox("商品コードを入力してください", "商品追加", , 100, 100)
    '商品名を受付
    Dim syouhinName As String
    syouhinName = InputBox("商品名を入力してください", "商品追加", , 100, 100)
    '色を受付
    Dim syouhinColor As String
    syouhinColor = InputBox("色を入力してください", "商品追加", , 100, 100)
    '単価を受付
    Dim syouhinTanka As String
    syouhinTanka = InputBox("単価を入力してください", "商品追加", , 100, 100)
    '輸入国を受付
    Dim syouhinYunyuu As String
    syouhinYunyuu = InputBox("輸入国を入力してください", "商品追加", , 100, 100)
    '入荷状況を受付
    Dim syouhinNyuuka As String
    syouhinNyuuka = InputBox("入荷状況を入力してください", "商品追加", , 100, 100)
    
    '商品コードを書込
    ActiveCell.Value = syouhinCode
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '商品名を書込
    ActiveCell.Value = syouhinName
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '色を書込
    ActiveCell.Value = syouhinColor
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '単価を書込
    ActiveCell.Value = syouhinTanka
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '輸入国を書込
    ActiveCell.Value = syouhinYunyuu
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '入荷状況を書込
    ActiveCell.Value = syouhinNyuuka
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
End Sub

６－３．二次元配列を用いてデータを格納した場合

Sub 商品追加()
    '表の最終行に移動
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim shouhin(5, 1) As String
    shouhin(0, 0) = ""
    shouhin(0, 1) = "商品コード"
    shouhin(1, 0) = ""
    shouhin(1, 1) = "商品名"
    shouhin(2, 0) = ""
    shouhin(2, 1) = "色"
    shouhin(3, 0) = ""
    shouhin(3, 1) = "単価"
    shouhin(4, 0) = ""
    shouhin(4, 1) = "輸入国"
    shouhin(5, 0) = ""
    shouhin(5, 1) = "入荷状況"
    
    '商品コードを受付
    shouhin(0, 0) = InputBox("商品コードを入力してください", "商品追加", , 100, 100)
    '商品名を受付
    shouhin(1, 0) = InputBox("商品名を入力してください", "商品追加", , 100, 100)
    '色を受付
    shouhin(2, 0) = InputBox("色を入力してください", "商品追加", , 100, 100)
    '単価を受付
    shouhin(3, 0) = InputBox("単価を入力してください", "商品追加", , 100, 100)
    '輸入国を受付
    shouhin(4, 0) = InputBox("輸入国を入力してください", "商品追加", , 100, 100)
    '入荷状況を受付
    shouhin(5, 0) = InputBox("入荷状況を入力してください", "商品追加", , 100, 100)
    
    '商品コードを書込
    ActiveCell.Value = shouhin(0, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '商品名を書込
    ActiveCell.Value = shouhin(1, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '色を書込
    ActiveCell.Value = shouhin(2, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '単価を書込
    ActiveCell.Value = shouhin(3, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '輸入国を書込
    ActiveCell.Value = shouhin(4, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
    '入荷状況を書込
    ActiveCell.Value = shouhin(5, 0)
    ActiveCell.BorderAround ColorIndex:=1
    ActiveCell.Offset(0, 1).Select
End Sub

６－４．プログラム内の同じ処理を行う部分をまとめた場合

Sub 商品追加()
    '表の最終行に移動
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim shouhin(5, 1) As String
    shouhin(0, 0) = ""
    shouhin(0, 1) = "商品コード"
    shouhin(1, 0) = ""
    shouhin(1, 1) = "商品名"
    shouhin(2, 0) = ""
    shouhin(2, 1) = "色"
    shouhin(3, 0) = ""
    shouhin(3, 1) = "単価"
    shouhin(4, 0) = ""
    shouhin(4, 1) = "輸入国"
    shouhin(5, 0) = ""
    shouhin(5, 1) = "入荷状況"

    'データの受取
    Dim i As Integer
    For i = 0 To 5
        shouhin(i, 0) = InputBox(shouhin(i, 1) + "を入力してください", "商品追加", , 100, 100)
    Next i
    
    'データの書込
    Dim j As Integer
    For j = 0 To 5
        ActiveCell.Value = shouhin(j, 0)
        ActiveCell.BorderAround ColorIndex:=1
        ActiveCell.Offset(0, 1).Select
    Next j
End Sub

６－５．ループを1つにまとめた場合

Sub 商品追加()
    '表の最終行に移動
    Range("B5").Select
    Do While Not (ActiveCell.Value = "")
        ActiveCell.Offset(1, 0).Select
    Loop
    
    Dim shouhin(5, 1) As String
    shouhin(0, 0) = ""
    shouhin(0, 1) = "商品コード"
    shouhin(1, 0) = ""
    shouhin(1, 1) = "商品名"
    shouhin(2, 0) = ""
    shouhin(2, 1) = "色"
    shouhin(3, 0) = ""
    shouhin(3, 1) = "単価"
    shouhin(4, 0) = ""
    shouhin(4, 1) = "輸入国"
    shouhin(5, 0) = ""
    shouhin(5, 1) = "入荷状況"

    Dim i As Integer
    For i = 0 To 5
        shouhin(i, 0) = InputBox(shouhin(i, 1) + "を入力してください", "商品追加", , 100, 100)
        ActiveCell.Value = shouhin(i, 0)
        ActiveCell.BorderAround ColorIndex:=1
        ActiveCell.Offset(0, 1).Select
    Next i
End Sub

追加課題(1/15)

色検索プログラムをIf文のみで実装せよ．
(P168 MsgBox関数の戻り値参照)

Sub 色検索()
    Dim iro As Integer
    iro = MsgBox("ワインの色は赤ですか？", vbYesNo)
    If iro = 6 Then
        Range("B5").Select
        Selection.AutoFilter 3, "赤"
    Else
        iro = MsgBox("ワインの色は白ですか？", vbYesNo)
        If iro = 6 Then
            Range("B5").Select
            Selection.AutoFilter 3, "白"
        Else
            iro = MsgBox("ワインの色はロゼですか？", vbYesNo)
            If iro = 6 Then
                Range("B5").Select
                Selection.AutoFilter 3, "ロゼ"
            Else
                MsgBox "選択が間違っています" & Chr(13) & _
                "赤､白､ロゼの中から選択してください", vbOKOnly + vbExclamation
            End If
        End If
    End If
End Sub

輸入国検索プログラムもIf文のみで実装せよ．

Sub 輸入国検索()
    Dim kuni As Integer
    kuni = MsgBox("輸入国はイタリアですか？", vbYesNo)
    If kuni = 6 Then
        Range("B5").Select
        Selection.AutoFilter 5, "イタリア"
    Else
        kuni = MsgBox("輸入国はフランスですか？", vbYesNo)
        If kuni = 6 Then
            Range("B5").Select
            Selection.AutoFilter 5, "フランス"
        Else
            MsgBox "入力が間違っています" & Chr(13) & _
        "イタリア，フランスのいずれかを入力してください", vbOKOnly + vbExclamation
        End If
    End If
End Sub