質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.04%

Excel VBA 意図しないところでChangeイベントが発生する

解決済

回答 3

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 3,575

score 19

前提・実現したいこと

VBAで入力情報の修正フォームを書いています。

フォーム上の値を修正したのち、実行すると、
'メイン処理
With ListBox1
Dim TargetIndex As Integer
TargetIndex = .ListIndex
のあたりで、
Private Sub ListBox1_Change()のところに戻ってしまい、リストボックス内の値が変わることなく、修正前の状態のままになってしまいます

Changeに戻らないようにするにはどうすればよいでしょうか。
Application.EnableEventではやはり解決できませんでした。

対策あれば教えていただきたいです。
よろしくお願いいたします。

※追記

2番目のソースコードを参考に今回のコードを書いたのですが、そちらではChangeイベントが発生しないまま進みます。
何の違いがあってこのようなことが起こるのか、教えていただきたいです。
よろしくお願いいたします。

該当のソースコード

Option Explicit

Private Sub UserForm_Initialize()
    Worksheets("マスタ").Select

    'リストボックスの設定
    With ListBox1
        .Font.Size = 10
        .ColumnCount = 8
        .ColumnWidths = "0;30;30;30;100;100;120"
        .TextAlign = fmTextAlignLeft
        .Font.Name = "MS ゴシック"

        '「マスタ」シートのセルの内容をリストボックスに転記
        Dim i As Integer
        Dim LastRow As Integer
        LastRow = Range("A65536").End(xlUp).Row
        For i = 2 To LastRow
            .AddItem Cells(i, 1).Value
            .List(.ListCount - 1, 1) = Cells(i, 2).Value
            .List(.ListCount - 1, 2) = Cells(i, 3).Value
            .List(.ListCount - 1, 3) = Cells(i, 4).Value
            .List(.ListCount - 1, 4) = Cells(i, 5).Value
            .List(.ListCount - 1, 5) = Cells(i, 6).Value
            .List(.ListCount - 1, 6) = Cells(i, 7).Value
            .List(.ListCount - 1, 7) = Cells(i, 8).Value
        Next
    End With

    'IDを変更不可能にする
    txtID.Locked = True
End Sub

Private Sub ListBox1_Change()
    With ListBox1
        Dim targetRow As Integer
        targetRow = .ListIndex

        txtID.Text = .List(targetRow, 0)
        txtName.Text = .List(targetRow, 5)
        txtFurigana.Text = .List(targetRow, 6)
        cmbNen.Text = .List(targetRow, 1)
        cmbKumi.Text = .List(targetRow, 2)
        txtNum.Text = .List(targetRow, 3)
        cmbSex.Text = .List(targetRow, 4)
        txtRemark.Text = .List(targetRow, 7)
    End With
End Sub

Private Sub btnCUpdate_Click()
    '「基本情報」を修正する
    Dim msg As String, title As String
    msg = "修正します。よろしいですか?"
    title = "修正の確認"

    Dim res As Integer
    res = MsgBox(msg, vbYesNo + vbInformation, title)
    If res = vbNo Then Exit Sub

    'メイン処理
    With ListBox1
        Dim TargetIndex As Integer
        TargetIndex = .ListIndex
        .List(TargetIndex, 1) = cmbNen.Text
        .List(TargetIndex, 2) = cmbKumi.Text
        .List(TargetIndex, 3) = txtNum.Text
        .List(TargetIndex, 4) = cmbSex.Text
        .List(TargetIndex, 5) = txtName.Text
        .List(TargetIndex, 6) = txtFurigana.Text
        .List(TargetIndex, 7) = txtRemark.Text
    End With

    'シートのデータを変更
    Dim tRow As Integer
    tRow = CInt(txtID.Text) + 1
    Cells(tRow, 2).Value = cmbNen.Text
    Cells(tRow, 3).Value = cmbKumi.Text
    Cells(tRow, 4).Value = txtNum.Text
    Cells(tRow, 5).Value = cmbSex.Text
    Cells(tRow, 6).Value = txtName.Text
    Cells(tRow, 7).Value = txtFurigana.Text
    Cells(tRow, 8).Value = txtRemark.Text

    '各コントロールのクリア
    cmbNen.Text = ""
    cmbKumi.Text = ""
    txtNum.Text = ""
    cmbSex.Text = ""
    txtName.Text = ""
    txtFurigana.Text = ""
    txtRemark.Text = ""
End Sub

Private Sub btnClose_Click()
    Unload Me
End Sub

Changeイベントが発生せずに進むコード

Option Explicit

Private Sub btnClose_Click()
    Unload Me
End Sub

Private Sub btnDelete_Click()
    Dim strMsg As String
    Dim strTitle As String
    Dim res As Integer  'MsgBoxの戻り値を格納

    strMsg = ListBox1.List(ListBox1.ListIndex, 1)  'リストボックスで選択された値の2列目(第2引数「1」)の値を変数に格納
    strMsg = strMsg & " を削除します。よろしいですか?"
    strTitle = "削除の確認"
    res = MsgBox(strMsg, vbYesNo + vbExclamation, strTitle)
    If res = vbNo Then Exit Sub

    '削除の処理
    Dim TargetRow As Integer
    TargetRow = ListBox1.Value + 1  'Valueプロパティにはリストボックスの選択された行の1列目の値が格納されているので、ここでは商品IDが変数に格納される
    Cells(TargetRow, 8).Value = 1

    'リストボックスの行を削除/更新
    ListBox1.RemoveItem ListBox1.ListIndex    '選択されている行番号(ListBox1.ListIndex)を引数に指定して削除
End Sub

Private Sub btnUpdate_Click()
    Dim Msg As String, Title As String
    Msg = "修正します。よろしいですか?"
    Title = "修正の確認"

    Dim res As Integer
    res = MsgBox(Msg, vbYesNo + vbInformation, Title)
    If res = vbNo Then Exit Sub

    'メイン処理(vbYes)
    With ListBox1
        Dim TargetIndex As Integer
        TargetIndex = .ListIndex  'どの行が選択されているかを変数に格納
        .List(TargetIndex, 1) = txtGoods.Text
        .List(TargetIndex, 2) = cboCategory.Value
        .List(TargetIndex, 3) = txtMaker.Text
        .List(TargetIndex, 4) = FormatAddSpace(Format(txtPrice.Text, "#,##0"), 10)
        .List(TargetIndex, 5) = txtUnit.Text
        .List(TargetIndex, 6) = txtRemark.Text
    End With

    'シートのデータを更新
    Dim TargetRow As Integer
    TargetRow = CInt(txtID.Text) + 1
    Cells(TargetRow, 2).Value = txtGoods.Text
    Cells(TargetRow, 3).Value = cboCategory.Text
    Cells(TargetRow, 4).Value = txtMaker.Text
    Cells(TargetRow, 5).Value = txtPrice.Text
    Cells(TargetRow, 6).Value = txtUnit.Text
    Cells(TargetRow, 7).Value = txtRemark.Text

    '各コントロール値のクリア
    txtID.Text = ""
    txtGoods.Text = ""
    cboCategory.Text = ""
    txtMaker.Text = ""
    txtPrice.Text = ""
    txtUnit.Text = ""
    txtRemark.Text = ""

End Sub

Private Sub ListBox1_Change()
    With ListBox1
        Dim TargetRow As Integer
        '現在選択されている項目を識別し、行番号を変数に格納
        TargetRow = .ListIndex

        'ListBox.Textには選択された行の値が格納されている(複数列の場合は1列目の値)
        txtID.Text = .Text
        txtGoods.Text = .List(TargetRow, 1)
        cboCategory.Text = .List(TargetRow, 2)
        txtMaker.Text = .List(TargetRow, 3)
        txtPrice.Text = Trim(.List(TargetRow, 4))   'スペース削除
        txtUnit.Text = .List(TargetRow, 5)
        txtRemark.Text = .List(TargetRow, 6)

        '修正ボタンと削除ボタンを有効にする
        btnUpdate.Enabled = True
        btnDelete.Enabled = True

    End With
End Sub

Private Sub UserForm_Initialize()
    '「商品マスタ」をフォームが表示されたときに選択する
    Worksheets("商品マスタ").Select

    'リストボックスの設定
    With ListBox1
        .Font.Size = 10
        .ColumnCount = 7
        .ColumnWidths = "50;100;80;80;100;30;70"
        .TextAlign = fmTextAlignLeft
        .Font.Name = "MS ゴシック"

        'リストボックスにデータを表示させる
        Dim i As Integer, LastRow As Integer
        LastRow = Range("A65536").End(xlUp).Row
        For i = 2 To LastRow
            If Cells(i, 8).Value <> 1 Then
                .AddItem FormatAddSpace(Cells(i, 1).Value, 4)
                .List(.ListCount - 1, 1) = Cells(i, 2).Value
                .List(.ListCount - 1, 2) = Cells(i, 3).Value
                .List(.ListCount - 1, 3) = Cells(i, 4).Value
                .List(.ListCount - 1, 4) = FormatAddSpace(Format(Cells(i, 5).Value, "#,##0"), 10)
                .List(.ListCount - 1, 5) = Cells(i, 6).Value
                .List(.ListCount - 1, 6) = Cells(i, 7).Value
            End If
        Next
    End With

    '商品IDを変更不可能にする
    txtID.Locked = True

    '修正ボタンと削除ボタンを無効にしておく
    btnUpdate.Enabled = False
    btnDelete.Enabled = False
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • sazi

    2019/02/25 20:44

    マークダウンの終わりの```がありません。

    キャンセル

  • kolobokkule

    2019/02/25 20:50

    失礼いたしました。

    キャンセル

回答 3

checkベストアンサー

+2

イベントの意味を理解して適切なイベントを利用しましょう。

今回、Changeイベントを利用してますが、これだとコードでデータを変更しても発生します。AfterUpdateイベントを使えば、ユーザーが変更した時には発生しますが、コードでデータを変更した場合は発生しませんので、今回の要件ならAfterUpdateイベントを使えば解決です。

Changeイベントでフラグを使って回避するという方法もありますが、冗長な感じがぬぐえません。


追記の2つのコードを見比べても違いはないようなので、後者はChangeイベントが発生しないというのはちょっと考えにくいです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/26 11:03

    AfterUpdateに変更したところ、うまく動いてくれました!本当にありがとうございます。
    フラグを使うと他の部分で不具合が生じてしまうため、悩んでおりました。
    同じような処理が何度も出てくるため、今回の回答は本当にありがたかったです。

    キャンセル

0

メイン処理部分で、リストボックスの内容変更してるので、Changeイベントが発生しています。

    'メイン処理
    With ListBox1
        Dim TargetIndex As Integer
        TargetIndex = .ListIndex
        .List(TargetIndex, 1) = cmbNen.Text  '←これ以降

XXXXXさんへ Excel VBA セルに書き込み時にLISTBOXのChangeイベントが発生について

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/25 22:30

    それはわかっています。
    URLありがとうございます。しかし私では解決に結びつけることはできませんでした。

    キャンセル

  • 2019/02/25 22:48

    追記のようなコードですと、イベントが発生しませんでした。
    書いておいて情けないのですが、その原因が分かりません。
    何か気づくところはありますでしょうか?

    キャンセル

0

フォームにはApplication.EnableEvents = Falseは効かなかったと思います。

Private Sub ListBox1_Change()
  Static ChangingFrag As Boolean
  If ChangingFrag Then Exit Sub
  ChangingFrag = True
  '途中略
  ChangingFrag = False
End Sub

とすれば良いかと。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.04%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る