Excel VBA課題(5)

第７章ワイン販売管理（完成）.xlsをベースに，販売データの入力を終了する際に，都度「end」という文字列を入力しなくても済むようにプログラムを変更せよ．

方針：
1回分の販売データの入力が終わったタイミングでデータ入力の終了・継続を確認するダイアログを表示し，その指示に従って動作を変更するようにする．

場所：
標準モジュール→販売リスト→Sub 入力()

sample code

Sub 入力()
    Dim hiduke As String
    ActiveWindow.NewWindow
    ActiveWindow.NewWindow
    Windows.Arrange xlArrangeStyleTiled
    Windows("第7章ワイン販売管理（完成）.xls:2").Activate
    Worksheets("得意先リスト").Select
    Windows("第7章ワイン販売管理（完成）.xls:1").Activate
    Worksheets("商品リスト").Select
    Windows("第7章ワイン販売管理（完成）.xls: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
    
    Dim flag As Integer
    flag = 0
    
    Do While ActiveCell.Offset(0, -1).Value <> ""
        hiduke = InputBox("日付を入力してください")
        If hiduke = "" Then
            Exit Do
        Else
            ActiveCell.FormulaR1C1 = hiduke
            ActiveCell.Offset(0, 1).Range("A1").Select
            ActiveCell.FormulaR1C1 = InputBox("得意先コードを入力してください")
            ActiveCell.Offset(0, 2).Range("A1").Select
            ActiveCell.FormulaR1C1 = InputBox("商品コードを入力してください")
            ActiveCell.Offset(0, 4).Range("A1").Select
            ActiveCell.FormulaR1C1 = InputBox("数量を入力してください")
            ActiveCell.Offset(1, -7).Range("A1").Select
        End If
        
        flag = MsgBox("入力を終了しますか？", vbYesNo + vbQuestion, "終了確認")
        If flag = "6" Then
            Exit Do
        End If
    
    Loop
    Windows("第7章ワイン販売管理（完成）.xls:2").Activate
    ActiveWindow.Close
    Windows("第7章ワイン販売管理（完成）.xls:1").Activate
    ActiveWindow.Close
    ActiveWindow.WindowState = xlMaximized
End Sub

Excel VBA課題(4)

第７章ワイン販売管理（完成）.xlsをベースに，商品リストの絞り込み検索をかける際の方法を，対話的な方法(ユーザーに文字を入力させない)に変更せよ．

sample code

Sub 色検索()
    Dim iro As String
    Dim flag As Integer
    flag = 0
    flag = MsgBox("検索したいワインは赤ですか？", vbYesNo + vbQuestion, "ワイン検索")
    If flag = "6" Then
        iro = "赤"
        Range("B5").Select
        Selection.AutoFilter Field:=3, Criteria1:=iro
    Else
        flag = MsgBox("検索したいワインは白ですか？", vbYesNo + vbQuestion, "ワイン検索")
        If flag = 6 Then
            iro = "白"
            Range("B5").Select
            Selection.AutoFilter Field:=3, Criteria1:=iro
        Else
            flag = MsgBox("検索したいワインはロゼですか？", vbYesNo + vbQuestion, "ワイン検索")
            If flag = 6 Then
                iro = "ロゼ"
                Range("B5").Select
                Selection.AutoFilter Field:=3, Criteria1:=iro
            Else
                MsgBox "赤、白、ロゼのいずれかを選択してください", vbOKOnly + vbExclamation
            End If
        End If
    End If
End Sub

Excel VBA課題(3)

20110912のファイルをベースとして，想定されるエラーに対する処理(5箇所)を追加する．
例)　商品ID(会員ID)が空欄の場合，商品ID(会員ID)の入力を促すメッセージを表示し，処理を中断する．

sample code

Sub point()
    '１．ワークシート「入力」に入力された文字列を取得(エラー処理あり)
    Dim errorFlag As Integer
    errorFlag = 0
    
    Dim syouhin As Integer
    If IsNumeric(Worksheets("入力").Range("B1").Text) Then
        syouhin = Worksheets("入力").Range("B1").Value
    ElseIf Worksheets("入力").Range("B1").Text = "" Then
        MsgBox "商品IDが空欄です．商品IDを入力してください．"
        errorFlag = 1
    Else
        MsgBox "正しい商品IDを入力してください．"
        errorFlag = 1
    End If
    
    Dim kaiin As Integer
    If IsNumeric(Worksheets("入力").Range("B2").Text) Then
        kaiin = Worksheets("入力").Range("B2").Value
    ElseIf Worksheets("入力").Range("B2").Text = "" Then
        MsgBox "会員IDが空欄です．会員IDを入力してください．"
        errorFlag = 1
    Else
        MsgBox "正しい会員IDを入力してください"
        errorFlag = 1
    End If
    
    If errorFlag = 0 Then
        '２．取得した「商品ID」から「価格」と「ポイント付与率」を取得
        Dim kakaku As Long
        Dim fuyoritsu As Integer
        
        Worksheets("商品").Select
        Worksheets("商品").Range("A2").Select
        
        Do While ActiveCell.Value <> ""
            If ActiveCell.Value = syouhin Then
                kakaku = ActiveCell.Offset(0, 2).Value
                fuyoritsu = ActiveCell.Offset(0, 3).Value
            End If
            'MsgBox "価格：" & kakaku & "、ポイント付与率" & fuyoritsu
            ActiveCell.Offset(1, 0).Select
        Loop
        
        '３．取得した「会員ID」から「保有ポイント数」と「会員種別」を取得
        Dim point As Long
        Dim syubetsu As Variant
        
        Worksheets("会員").Select
        Worksheets("会員").Range("A2").Select
        
        Do While ActiveCell.Value <> ""
            If ActiveCell.Value = kaiin Then
                point = ActiveCell.Offset(0, 2).Value
                syubetsu = ActiveCell.Offset(0, 3).Value
            End If
            ActiveCell.Offset(1, 0).Select
        Loop
        
        '４．取得した「価格」と「保有ポイント数」から「支払金額」を表示
        Dim kingaku As Long
        Worksheets("入力").Select
        kingaku = kakaku - point
        Worksheets("入力").Range("B4").Value = kingaku
        
        Worksheets("入力").Range("B6").Value = kakaku
        If syubetsu = "ゴールド" Then
            fuyoritsu = fuyoritsu * 2
        End If
        Worksheets("入力").Range("B7").Value = kakaku * fuyoritsu / 100
    End If
End Sub

download

Excel VBA課題(2)

20110907の課題で作成したVBAをベースとして，「商品ID」「会員ID」を入力し、保有ポイントを使用した場合の支払金額と併せて，ポイントを使用しない場合の支払金額と付与ポイント数を表示する．

※用意するExcelのシートは3つ「商品」「会員」「入力」
※1ポイント＝1円換算※ポイント使用時は、ポイントは付与されない．

※会員種別として，通常会員/ゴールド会員の2つの区分を用意する．
※ゴールド会員は通常会員と比べて付与ポイント数が2倍とする．

sample code

Sub point()

    '１．ワークシート「入力」に入力された文字列を取得
    Dim syouhin As Integer
    syouhin = Worksheets("入力").Range("B1").Value
    
    Dim kaiin As Integer
    kaiin = Worksheets("入力").Range("B2").Value
    
    '２．取得した「商品ID」から「価格」と「ポイント付与率」を取得
    Dim kakaku As Long
    Dim fuyoritsu As Integer
    
    Worksheets("商品").Select
    Worksheets("商品").Range("A2").Select
    
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = syouhin Then
            kakaku = ActiveCell.Offset(0, 2).Value
            fuyoritsu = ActiveCell.Offset(0, 3).Value
        End If
        'MsgBox "価格：" & kakaku & "、ポイント付与率" & fuyoritsu
        ActiveCell.Offset(1, 0).Select
    Loop
    
    '３．取得した「会員ID」から「保有ポイント数」と「会員種別」を取得
    Dim point As Long
    Dim syubetsu As Variant
    
    Worksheets("会員").Select
    Worksheets("会員").Range("A2").Select
    
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = kaiin Then
            point = ActiveCell.Offset(0, 2).Value
            syubetsu = ActiveCell.Offset(0, 3).Value
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
    '４．取得した「価格」と「保有ポイント数」から「支払金額」を表示
    Dim kingaku As Long
    Worksheets("入力").Select
    kingaku = kakaku - point
    Worksheets("入力").Range("B4").Value = kingaku
    
    Worksheets("入力").Range("B6").Value = kakaku
    If syubetsu = "ゴールド" Then
        fuyoritsu = fuyoritsu * 2
    End If
    Worksheets("入力").Range("B7").Value = kakaku * fuyoritsu / 100
End Sub

download

Excel VBA課題(1)

「商品ID」「会員ID」を入力し、保有ポイントを使用した場合の金額を表示する．
 (まずは「佐藤」が「テレビ」を購入した場合を考える) 

※用意するExcelのシートは3つ「商品」「会員」「入力」
※1ポイント＝1円換算
※ポイント使用時は、ポイントは付与されない．

sample code

Sub point()

    '１．ワークシート「入力」に入力された文字列を取得
    Dim syouhin As Integer
    syouhin = Worksheets("入力").Range("B1").Value
    
    Dim kaiin As Integer
    kaiin = Worksheets("入力").Range("B2").Value
    
    'MsgBox "商品ID：" & syouhin & ", 会員ID：" & kaiin

    
    '２．取得した「商品ID」から「価格」を取得
    Dim kakaku As Long
    kakaku = 0
    
    Worksheets("商品").Select
    Worksheets("商品").Range("A2").Select
    
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = syouhin Then
            kakaku = ActiveCell.Offset(0, 2).Value
        End If
        
        'MsgBox "価格：" & kakaku
        
        ActiveCell.Offset(1, 0).Select
    Loop
    
    
    '３．取得した「会員ID」から「保有ポイント数」を取得
    Dim point As Long
    point = 0
    
    Worksheets("会員").Select
    Worksheets("会員").Range("A2").Select
    
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = kaiin Then
            point = ActiveCell.Offset(0, 2).Value
        End If
        
        'MsgBox "ポイント：" & point
        
        ActiveCell.Offset(1, 0).Select
    Loop

    '４．取得した「価格」と「保有ポイント数」から「支払金額」を表示
    Worksheets("入力").Select
    
    Dim kingaku As Long
    kingaku = kakaku - point
    
    'MsgBox "支払金額：" & kingaku
    Worksheets("入力").Range("B4").Value = kingaku

End Sub

download

Microsoft Excel 2010でマクロ/VBAを有効にする方法

Microsoft Excel 2010では，標準の状態ではマクロ/VBAが使用できないようになっています． マクロを使用するためには，以下の設定を変更する必要があります．

１．メニューの中の「ファイル」から「オプション」を選択

２．リボンのユーザー設定から，「開発」の右側にあるチェックボックスにチェックを入れる

３． これでリボン(ツールバー)に「開発」タブが表示されるようになります．この「開発」タブの中にVisualBasicEditorやマクロを呼び出す為のボタンが含まれています．

４．リボンに表示された「開発」タブの中の「マクロのセキュリティ」ボタンを押し「セキュリティセンター」の画面を開きます．セキュリティの設定を以下のように変更します．

以上．