【販売管理システム作成】登録済みのデータを削除する方法【削除フラグの立て方】

販売管理システム【見積編】

みなさん、こんにちはケンケンです。

販売管理システムをエクセルを使い倒して作っちゃおうというシリーズをお伝えしています。

前回は、登録済みのデータを修正する方法をご紹介しました。

前回記事

【販売管理システム作成】登録済みのデータを修正削除する方法【見積システム完成編】

みなさん、こんにちはケンケンです。販売管理システムの作成を通してエクセルを学んでいくことを目指したシリーズです。前回は、とうとう新規登録画面の完成までこぎつけました。 [sitecard subti[…]

復習中心の回になりましたが、全体像やフォームを作るコツを思い出すのにちょうどよかったのではないでしょうか。

今回は、登録済みデータの削除を試みます。

エクセルシートにちょっとした工夫をすることによって実際にデータを削除することなく、

ユーザーには削除したように見せることができます。

SQLなどデータベースを勉強するときにも役立ちますので、参考にしていただければと思います。

それでは、以下ご覧ください。

1 登録済みデータを削除してみよう
2 見積情報検索フォーム（frmMitumoriSearch）のコードも修正しよう
- 2.1 見積書作成ボタンをクリックしたときのアクション
3 まとめ

登録済みデータを削除してみよう

データを削除してみようと題しましたが、結論から言うと実際にデータを削除することはしません。

削除フラグを立てるということ

どういうことかと言うと、エクセルシートに削除フラグを立てて削除したことにするのです。

言葉ではよく分からないと思いますので、下図をご覧ください。

その時エクセルシートでは・・・

ご覧のようにエクセルシート（見積データ一覧）のN列に新たに「削除」欄を設けて、

削除実行されたデータに対して「d（delete）」と表記しています。

※実際のデータベースでは、「０」と「１」で削除かそうでないか判断することが多いです。

これをフラグを立てると言います。

こうすることで、削除されたデータをシートから削除せずに、リストボックス上からは削除することが可能です。

削除フラグのメリット

メリットはデータが完全削除されるわけではなく復元できることにあります。

これは、本来管理者側のメリットで、ユーザーにとってはメリットと言えませんが、

エクセルシートをユーザーが直接編集できるという前提であれば、

間違って削除したデータを復元することが可能です。

データベースの概念からは外れますが、がちがちにシステマチックにせず、ここは少しゆるく考えています。

削除フラグを立てるコードを書こう

それでは、実際に削除フラグを立てて見た目の上で削除するコードを書いていきましょう。

VBEを起動して、frmMitumoriDeleteフォームの「選択行削除」をダブルクリックしてプロシージャを作りコードを書きます。

Private Sub cmbSakujo_Click()
    If lstMitumori.ListIndex = -1 Then
        MsgBox "データ一覧リストから選択してください。"
        Exit Sub
    End If

    Dim msg
    Dim title
    msg = "削除します。よろしいですか？"
    title = "確認"
    Dim res
    res = MsgBox(msg, vbYesNo + vbExclamation + vbDefaultButton2, title)
    If res = vbNo Then
        Exit Sub
    End If
    
    Dim cnt
    Dim Lrow
    Dim targetrow
    Dim targetrow2
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row
    
    For cnt = 2 To Lrow
        If Format(Sheets("見積データ一覧").Range("A" &amp; cnt).Value, "00000") = lstMitumori.Value Then
            targetrow = cnt
            Exit For
        End If
    Next
    targetrow2 = targetrow + lstMeisai.ListIndex
    Sheets("見積データ一覧").Range("N" &amp; targetrow2).Value = "d"'①
    lstMeisai.RemoveItem lstMeisai.ListIndex
End Sub

Private Sub cmbSakujo_Click()

If lstMitumori.ListIndex = -1 Then

MsgBox "データ一覧リストから選択してください。"

Exit Sub

End If

Dim msg

Dim title

msg = "削除します。よろしいですか？"

title = "確認"

Dim res

res = MsgBox(msg, vbYesNo + vbExclamation + vbDefaultButton2, title)

If res = vbNo Then

Exit Sub

End If

Dim cnt

Dim Lrow

Dim targetrow

Dim targetrow2

Lrow = Sheets("見積データ一覧").Range("A" & Rows.Count).End(xlUp).Row

For cnt = 2 To Lrow

If Format(Sheets("見積データ一覧").Range("A" & cnt).Value, "00000") = lstMitumori.Value Then

targetrow = cnt

Exit For

End If

targetrow2 = targetrow + lstMeisai.ListIndex

Sheets("見積データ一覧").Range("N" & targetrow2).Value = "d"'①

lstMeisai.RemoveItem lstMeisai.ListIndex

End Sub

コードの解説

それでは、コードの解説をします。

今回説明するのは①の部分だけです。

その他の部分はちょっと長いですが、すでに学んだことがほとんどなので恐れることはありません。

削除機能の実装について不安のある方は、以下の記事で復習しておきましょう。

削除機能復習記事

【販売管理システム作成】見積データ登録用のフォームを作ろう⑤【修正削除機能の実装】

みなさん、こんにちはケンケンです。エクセルを駆使して販売管理システムを作るシリーズを紹介しています。機能やフォームが複数あるものを作り上げるのは根気がいりますが、じっくり基礎を固めてアウトプットすれば恐れ[…]

それでは、①ですが、まず変数targetrow2に格納されている数値は、

エクセルシートの該当データであることを確認してください。

つまり、リストボックスから削除しようとしているデータと同じデータがエクセルシートの

何行目にあるかを調べて格納している、と言い換えてもよいでしょう。

その該当データのN列目に「d」と入力します。

これで、フラグを立てることができました。

リストボックスをクリックしたときのアクションを変更しよう

しかし、これで完成ではありません。

このままでは、上のリストボックスをクリックした際に削除したはずのデータが

下のリストボックスに載ってしまいます。

これではよくないので、コードを修正します。

具体的には、リストボックスに値を入れる時に削除列（AB）に「d」が入っているかを確認し、

入っていたらリストボックスに転記しないように制御するコードを追加します。

Private Sub lstMitumori_Click()
    Dim Lrow
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row
    Sheets("見積データ一覧").Activate
    Range("Q2").Value = ""
    Range("Q2").Value = lstMitumori.Value
    Sheets("見積データ一覧").Range("A1:N" &amp; Lrow).AdvancedFilter Action:=xlFilterCopy, _
        criteriarange:=Range("O1:Q2"), copytorange:=Range("O4:AB4")'①
        
     With lstMeisai
        .Clear
        Lrow = Sheets("見積データ一覧").Range("O" &amp; Rows.Count).End(xlUp).Row
        Dim cnt
        For cnt = 5 To Lrow
            If Range("AB" &amp; cnt).Value &lt;&gt; "d" Then'②
                .AddItem Range("R" &amp; cnt).Value
                .List(.ListCount - 1, 1) = Range("T" &amp; cnt).Value
                .List(.ListCount - 1, 2) = Range("U" &amp; cnt).Value
                .List(.ListCount - 1, 3) = Format(Range("V" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 4) = Format(Range("W" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 5) = Format(Range("X" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 6) = Format(Range("AA" &amp; cnt).Value, "#,###")
            End If'②
        Next
     End With
End Sub

Private Sub lstMitumori_Click()

Dim Lrow

Lrow = Sheets("見積データ一覧").Range("A" & Rows.Count).End(xlUp).Row

Sheets("見積データ一覧").Activate

Range("Q2").Value = ""

Range("Q2").Value = lstMitumori.Value

Sheets("見積データ一覧").Range("A1:N" & Lrow).AdvancedFilter Action:=xlFilterCopy, _

criteriarange:=Range("O1:Q2"), copytorange:=Range("O4:AB4")'①

With lstMeisai

.Clear

Lrow = Sheets("見積データ一覧").Range("O" & Rows.Count).End(xlUp).Row

Dim cnt

For cnt = 5 To Lrow

If Range("AB" & cnt).Value <> "d" Then'②

.AddItem Range("R" & cnt).Value

.List(.ListCount - 1, 1) = Range("T" & cnt).Value

.List(.ListCount - 1, 2) = Range("U" & cnt).Value

.List(.ListCount - 1, 3) = Format(Range("V" & cnt).Value, "#,###")

.List(.ListCount - 1, 4) = Format(Range("W" & cnt).Value, "#,###")

.List(.ListCount - 1, 5) = Format(Range("X" & cnt).Value, "#,###")

.List(.ListCount - 1, 6) = Format(Range("AA" & cnt).Value, "#,###")

End If'②

End With

End Sub

プロシージャすべてを書きましたが、追加する部分は②のIfからEndIfまでの部分です。

もし、AB列に「ｄ」が入っていなかったらという条件式を追加して、リストボックスにデータを転記するように書き換えています。

AB４セルに「削除」と入力しておきます。入力しておかないとエラーになりますので注意してください。

①は削除欄を設けたため抽出元と抽出先の範囲を一列ずつ追加しています。

これで、削除したデータをエクセルシート上から消滅させずに管理することができました。

見積情報検索フォーム（frmMitumoriSearch）のコードも修正しよう

見積情報検索フォームの見積書作成ボタンをクリックすると、選択した見積Noの見積書を作成してくれました。

しかし、今のままだと先ほど削除したデータを含めた見積書を作成してしまいます。

これを修正しましょう。

見積書作成ボタンをクリックしたときのアクション

このボタンをクリックしたときに見積書作成が実行されましたが、直接エクセルシートからデータを引っ張ってきていました。

現状、エクセルシートにフィルターをかけて転記しているのは、削除を考慮していません。

そこで、削除フラグが立っているデータはフィルターをかけないように変更します。

コードの変更は大したことありません。以下のように変更してください。

Private Sub lstMitumori_Change()
    Dim Lrow
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row
    Sheets("見積データ一覧").Activate
    Range("Q2").Value = ""
    Range("Q2").Value = lstMitumori.Value
    Range("R2").Value = "&lt;&gt;" &amp; "d"'①
    Sheets("見積データ一覧").Range("A1:N" &amp; Lrow).AdvancedFilter Action:=xlFilterCopy, _
        criteriarange:=Range("O1:R2"), copytorange:=Range("O4:AB4")'②
        
     With lstMeisai
        .Clear
        Lrow = Sheets("見積データ一覧").Range("O" &amp; Rows.Count).End(xlUp).Row
        Dim cnt
        For cnt = 5 To Lrow
            If Range("AB" &amp; cnt).Value &lt;&gt; "d" Then'③
                .AddItem Range("R" &amp; cnt).Value
                .List(.ListCount - 1, 1) = Range("T" &amp; cnt).Value
                .List(.ListCount - 1, 2) = Range("U" &amp; cnt).Value
                .List(.ListCount - 1, 3) = Format(Range("V" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 4) = Format(Range("W" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 5) = Format(Range("X" &amp; cnt).Value, "#,###")
                .List(.ListCount - 1, 6) = Format(Range("AA" &amp; cnt).Value, "#,###")
            End If'③
        Next
     End With
     btnCreat.Enabled = True
     btnUpdate.Enabled = True
End Sub