VBA で、リストの値が特定の値から特定の値に変更された場合になにか処理をする方法

●条件
(あ) 列 B は、「データの入力規則」で入力値の種類が「リスト」で、下記の値をとります。
  「0-新規」
  「1-値段調査中」
  「2-値段調査完了」
  「3-商品購入中」
  「4-商品購入完了」
  「5-処理完了」
(い) 列 Bが「2-値段調査完了」に値が変更されたら、列 Cに本日の日付を自動入力します。
(う) 以下のコードで (い) を実現しています。
  Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column = 2 And Target.Value = "2-値段調査完了" Then
    Cells(Target.Row, 3).Value = Date
   End If
  End Sub
(え) 列 B の値はステータス(状態遷移)の意味を持ち、基本的には 0番から4番へと1つずつ順番に進み、
  逆戻りすることはありません。[例] 2番から1番へ変更されることは、まれにしかない。

(お) Microsoft Office Excel 2013 を使用しています。

 ※文字数制限のため続きは、コメントに入力します。

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2015/08/22 11:05:29
  • 終了:2015/08/22 13:47:45
id:goto_hirosi

●実現したいこと
 ・(え) の条件を満たすために、もし、列 Bの値が逆順へと変化した場合([例] 2番から1番へと変更)に、
  ダイアログボックスで「ステータスを逆順に変更しようとしてます。よろしいですか?」と表示し、「YES」か「NO」の入力を促すようにしたい。
 ・「YES」が入力されたら、列 B の値を変更し、列 C の値日付をクリアする。
 ・「NO」が入力されたら、列 B の値を変更しない。

●お願いしたい事
 ・ソースコードを教えて頂きたいです。

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4439ベストアンサー獲得回数18232015/08/22 12:56:47

ポイント500pt

こんな感じでどうでしょうか。

Dim Before_B_Value As String

Private Function IsSequentialStatus(Next_Value, Before_Value)
    n = CInt(Left(Next_Value, 1))
    If Before_Value <> "" Then
        b = CInt(Left(Before_Value, 1))
    Else
        b = -1
    End If
    If b < n Then
        IsSequentialStatus = True
    ElseIf b > n Then
        IsSequentialStatus = False
    Else
        ' ここには来ないはず...
        Debug.Print "??? : n, b = " & n & ", " & b
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 2 Then
            ' B列が削除された場合の処理
            If Target.Value = "" Then
                Before_B_Value = ""
                Debug.Print "B列が削除されたっ!"
                Exit Sub
            End If
            If IsSequentialStatus(Target.Value, Before_B_Value) Then
                If Target.Value = "2-値段調査完了" Then
                    Cells(Target.Row, 3).Value = Date
                End If
            Else
                btn = MsgBox("ステータスを逆順に変更しようとしてます。よろしいですか?", vbYesNo, "確認")
                If btn = vbYes Then
                    Cells(Target.Row, 3).Clear
                Else
                    Application.EnableEvents = False
                    Target.Value = Before_B_Value
                    Application.EnableEvents = True
                End If
            End If
            Before_B_Value = Target.Value
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 2 Then
            Before_B_Value = Target.Value
        End If
    End If
End Sub

対象シートのコードのところに貼ってください。
質問にある Worksheet_Change の処理は入れてありますが、既に Worksheet_SelectionChange にも処理がある場合には、処理を追記してください。

B列で削除をしたときの仕様が分からなかったので、とりあえずエラーにならないようにだけしています。
削除を考慮するとしたら、範囲指定で削除される場合の考慮も必要になります(ちょっと面倒)。

他1件のコメントを見る
id:goto_hirosi

連投失礼します。
動作しました!

Dim n As Integer
Dim b As Integer
Dim btn As Integer

を、それぞれの変数が使用される直前に挿入しました。

早々のご回答ありがとうございました!
動作したため、ベストアンサーにさせて頂き、質問を終了します。

2015/08/22 13:47:15
id:a-kuma3

Option Explicit 使う派ですか。
ぼくは動けばOK派なので、滅多に使いません :-)

2015/08/22 13:52:59

その他の回答(0件)

id:a-kuma3 No.1

a-kuma3回答回数4439ベストアンサー獲得回数18232015/08/22 12:56:47ここでベストアンサー

ポイント500pt

こんな感じでどうでしょうか。

Dim Before_B_Value As String

Private Function IsSequentialStatus(Next_Value, Before_Value)
    n = CInt(Left(Next_Value, 1))
    If Before_Value <> "" Then
        b = CInt(Left(Before_Value, 1))
    Else
        b = -1
    End If
    If b < n Then
        IsSequentialStatus = True
    ElseIf b > n Then
        IsSequentialStatus = False
    Else
        ' ここには来ないはず...
        Debug.Print "??? : n, b = " & n & ", " & b
    End If
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 2 Then
            ' B列が削除された場合の処理
            If Target.Value = "" Then
                Before_B_Value = ""
                Debug.Print "B列が削除されたっ!"
                Exit Sub
            End If
            If IsSequentialStatus(Target.Value, Before_B_Value) Then
                If Target.Value = "2-値段調査完了" Then
                    Cells(Target.Row, 3).Value = Date
                End If
            Else
                btn = MsgBox("ステータスを逆順に変更しようとしてます。よろしいですか?", vbYesNo, "確認")
                If btn = vbYes Then
                    Cells(Target.Row, 3).Clear
                Else
                    Application.EnableEvents = False
                    Target.Value = Before_B_Value
                    Application.EnableEvents = True
                End If
            End If
            Before_B_Value = Target.Value
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 2 Then
            Before_B_Value = Target.Value
        End If
    End If
End Sub

対象シートのコードのところに貼ってください。
質問にある Worksheet_Change の処理は入れてありますが、既に Worksheet_SelectionChange にも処理がある場合には、処理を追記してください。

B列で削除をしたときの仕様が分からなかったので、とりあえずエラーにならないようにだけしています。
削除を考慮するとしたら、範囲指定で削除される場合の考慮も必要になります(ちょっと面倒)。

他1件のコメントを見る
id:goto_hirosi

連投失礼します。
動作しました!

Dim n As Integer
Dim b As Integer
Dim btn As Integer

を、それぞれの変数が使用される直前に挿入しました。

早々のご回答ありがとうございました!
動作したため、ベストアンサーにさせて頂き、質問を終了します。

2015/08/22 13:47:15
id:a-kuma3

Option Explicit 使う派ですか。
ぼくは動けばOK派なので、滅多に使いません :-)

2015/08/22 13:52:59

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません