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

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

ただいまの
回答率

88.04%

VBA フォーム上で検索したデータを削除したい。。。関係ないデータが削除される

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 328

前提・実現したいこと

在庫管理フォームの作成(1つのフォームでデータの登録、検索、削除)を行えるようにしたいです。
Sheet1にはA列=材質  B列=板厚 C列=縦寸法 D列=横寸法 のデータが入っています。

発生している問題・エラーメッセージ

削除ボタンを押したときにシート上ではリストボックスで選択したデータと違うデータが削除されてしまいます。
エラーメッセージはありません。

該当のソースコード

Private Sub Workbook_Open()
   UserForm2.Show
End Sub


Private Sub clrB_Click()
   ComboBox1.Value = ""
   TextBox1.Value = ""
   TextBox2.Value = ""
   TextBox3.Value = ""
End Sub


Private Sub delB_Click()
  Worksheets("Sheet1").Select
  Dim index As Integer
       index = UserForm2.ListBox1.ListIndex         
   If index = -1 Then
       MsgBox "データが選択されていません "
   Else
       msg = MsgBox("      " & ComboBox1.Value & "  " & TextBox1.Value & "t  " & TextBox2.Value & "×" & TextBox3.Value & vbCrLf & vbCrLf & "  このデータを消去しますがよろしいですか?", Buttons:=vbYesNo)
      If msg = vbYes Then          
         Rows(ListBox1.ListIndex + 2).Delete
         UserForm2.ListBox1.RemoveItem index  'リストボックスに表示されたデータを消去する
           ComboBox1.Value = ""
           TextBox1.Value = ""
           TextBox2.Value = ""
           TextBox3.Value = ""
         MsgBox "消去しました"
      Else
         MsgBox "中止しました"
      End If
   End If   
End Sub


Private Sub ListBox1_Click()
    If TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 2) And TextBox3.Value = ListBox1.List(ListBox1.ListIndex, 3) 
      Then
        delB.Enabled = True
      Else
        delB.Enabled = False
    End If
End Sub

Private Sub owari_Click()
   Unload UserForm2
   Sheets(1).Select
End Sub


Private Sub touroku_Click()       
    If ComboBox1.Value = "" Then
        MsgBox "材質を選択してください。"
        ComboBox1.SetFocus
        Exit Sub
    End If    
    If TextBox1.Value = "" Then
        MsgBox "板厚を入力してください。"
        TextBox1.SetFocus
        Exit Sub
    End If
    If TextBox1.Value > 12 Then
       MsgBox "板厚の数値を見直してください。"
       Exit Sub
    End If
    If TextBox2.Value = "" Then
        MsgBox "端材寸法を入力してください。"
        TextBox2.SetFocus
        Exit Sub
    End If
    If TextBox3.Value = "" Then
        MsgBox "端材寸法を入力してください。"
        TextBox3.SetFocus
        Exit Sub
    End If
        msg = MsgBox("      " & ComboBox1.Value & "  " & TextBox1.Value & "t  " & TextBox2.Value & "×" & TextBox3.Value & vbCrLf & vbCrLf & "    端材を登録しますか?", Buttons:=vbYesNo)
    If msg = vbYes Then
      Me.Hide
      Sheet1.Select
      Range("A1").End(xlDown).Offset(1, 0).Select
      ActiveCell.Value = ComboBox1.Value
      ActiveCell.Offset(0, 1).Value = TextBox1.Value
      ActiveCell.Offset(0, 2).Value = TextBox2.Value
      ActiveCell.Offset(0, 3).Value = TextBox3.Value
      ComboBox1.Value = ""
      TextBox1.Value = ""
      TextBox2.Value = ""
      TextBox3.Value = ""
      ListBox1.Clear
      MsgBox "登録しました"
      Me.Show
    Else
      MsgBox "元の画面に戻ります"
    End If 
End Sub


Private Sub UserForm_Initialize()
  With ComboBox1
      .AddItem "SPHC"
      .AddItem "SPCC"
      .AddItem "ボンデ"
      .AddItem "SUS"
      .AddItem "SUS430"
  End With  
   delB.Enabled = False   
End Sub


Private Sub kensaku_Click()
 Dim maxRow As Long
 Dim myData As Variant
 Dim myData2() As Variant
 Dim i As Long, j As Long, cn As Long 
     With Worksheets("Sheet1")
        maxRow = .Cells(Rows.Count, 1).End(xlUp).Row             'Worksheet(1)の最終行の取得
        myData = .Range(.Cells(1, 1), .Cells(maxRow, 4)).Value    'データ格納
     End With
  ReDim myData2(1 To maxRow, 1 To 4)
     For i = LBound(myData) To UBound(myData)       
      If myData(i, 1) Like "*" & ComboBox1.Value & "*" And myData(i, 2) Like "*" & TextBox1.Value & "*" Then
        cn = cn + 1
           myData2(cn, 1) = myData(i, 1)
           myData2(cn, 2) = myData(i, 2)
           myData2(cn, 3) = myData(i, 3)
           myData2(cn, 4) = myData(i, 4)
      End If
     Next i

     With ListBox1
      .ColumnCount = 4
      .ColumnWidths = "75;75;65;65"
      .List = myData2
     End With    
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)           
     ComboBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
     TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 1)
     TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 2)
     TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 3)
     delB.Enabled = True     
End Sub


Private Sub Usetform_Initialize()
 Dim maxRow As Long
 Dim myDate, myDate2()
 Dim i As Long, j As Long

   With Worksheets("Sheet1")
        maxRow = .Cells(Rows.Count, 1).End(xlUp).Row
        myDate = .Range(.Cells(1, 1), .Cells(maxRow, 4)).Value
   End With   
   ReDim myDate2(1 To maxRow, 1 To 3)

   For i = LBound(myDate) To UBound(myDate)
      myDate2(i, 1) = myDate(i, 1)
      myDate2(i, 2) = myDate(i, 2)
      myDate2(i, 3) = myData(i, 3)
      myData2(i, 4) = myDate(i, 4)
   Next i
   With ListBox1
       .ColumnCount = 4
       .ColumnWidths = "75;75;65;65"
       .List = myData2
   End With  
End Sub

試したこと

コードは色んなサイト様から引用して作りました。
お恥ずかしいですがコードの組み立て方など基本がほとんど理解できておりません。
エラーが出ないので何が違うのかわからず行き詰っております。
どうか、よろしくおねがいいたします。

補足情報(FW/ツールのバージョンなど)

  • 気になる質問をクリップする

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

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

  • radames1000

    2020/09/04 13:39

    最後のUsetform_Initializeって何ですか?
    すでにUserform_Initializeはあるし。謎です。

    キャンセル

  • meg_

    2020/09/04 22:21

    コードを1行ずつデバッグして原因を見つけてください。

    キャンセル

回答 1

checkベストアンサー

0

全部読んだわけでじゃないですが

これだと固定位置になってませんか。

Rows(ListBox1.ListIndex + 2).Delete

お恥ずかしいですがコードの組み立て方など基本がほとんど理解できておりません。

では基本を理解してから。
ここで応急処置だけ教えてもらっても一生自分でメンテナンスできるようになりません。何かあるたびに他人を頼るのは非効率ですし、「分かった気」になるだけです。

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

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

関連した質問

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