(5)売上伝票(削除)
10000件のデータで20秒かかりました。3000件を超えると直接売上明細シートの削除を使ったほうがよいと思います。
通常データベースは削除フラグだけをつけて処理をしますのでスピードは問題ないです。
あとから必要があれば削除フラグを完全に削除する処理をする場合もあります。
VBAでそれをすると処理が難しくなります。
標準モジュールに伝票削除フォームが開くプロシージャを記述します。
Sub 伝票削除()
frmSakujyo.Show
End Sub
伝票削除フォーム
伝票削除は伝票照会と同じプログラムを使って削除したい伝票を選択します。
伝票削除フォームのオブジェクト名一覧
Private Sub cmdSakusei_Click()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim kei As Long
lastrow = Worksheets("伝票ヘッダー").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 1 To 5
Worksheets("伝票ヘッダー").Cells(i, j) = ""
Next
Next
lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
j = 2
For i = 2 To lastrow
kei = kei + Worksheets("売上明細").Cells(i, 9)
If Worksheets("売上明細").Cells(i, 1) <> Worksheets("売上明細").Cells(i + 1, 1) Then
Worksheets("伝票ヘッダー").Cells(j, 1) = Worksheets("売上明細").Cells(i, 1)
Worksheets("伝票ヘッダー").Cells(j, 2) = Worksheets("売上明細").Cells(i, 2)
Worksheets("伝票ヘッダー").Cells(j, 3) = Worksheets("売上明細").Cells(i, 3)
Worksheets("伝票ヘッダー").Cells(j, 4) = Worksheets("売上明細").Cells(i, 4)
Worksheets("伝票ヘッダー").Cells(j, 5) = kei
j = j + 1
kei = 0
End If
Next
lastrow = Worksheets("伝票ヘッダー").Cells(Rows.Count, 1).End(xlUp).Row
lstDenpyou.ColumnCount = 5
For i = 2 To lastrow
With lstDenpyou
.Clear
End With
Next
For i = 2 To lastrow
With lstDenpyou
.AddItem
.List(i - 2, 0) = Worksheets("伝票ヘッダー").Cells(i, 1)
.List(i - 2, 1) = Worksheets("伝票ヘッダー").Cells(i, 2)
.List(i - 2, 2) = Worksheets("伝票ヘッダー").Cells(i, 3)
.List(i - 2, 3) = Worksheets("伝票ヘッダー").Cells(i, 4)
.List(i - 2, 4) = Worksheets("伝票ヘッダー").Cells(i, 5)
End With
Next
End Sub
Private Sub UserForm_Initialize()
Dim lastrow As Long
Dim i As Long
lastrow = Worksheets("伝票ヘッダー").Cells(Rows.Count, 1).End(xlUp).Row
lstDenpyou.ColumnCount = 5
For i = 2 To lastrow
With lstDenpyou
.AddItem
.List(i - 2, 0) = Worksheets("伝票ヘッダー").Cells(i, 1)
.List(i - 2, 1) = Worksheets("伝票ヘッダー").Cells(i, 2)
.List(i - 2, 2) = Worksheets("伝票ヘッダー").Cells(i, 3)
.List(i - 2, 3) = Worksheets("伝票ヘッダー").Cells(i, 4)
.List(i - 2, 4) = Worksheets("伝票ヘッダー").Cells(i, 5)
End With
Next
End Sub
Private Sub lstDenpyou_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
txtDenno.Text = lstDenpyou.Text
End Sub
削除確認メッセージ
OKボタンをクリックすると削除してもよいか確認メッセージが表示されます。
1)削除していないデータを作業シートにコピーするために作業シートをクリアします。
2)売上伝票を削除した作業シートを売上明細に移行するために売上明細シートをクリアして作業シートをコピーします。
Private Sub cmdOk_Click()
Dim rc As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim lastrow As Long
rc = MsgBox("削除しますか?", vbYesNo + vbCritical)
If rc <> vbYes Then
Exit Sub
End If
'伝票NO明細データ削除
'作業シートクリア
Worksheets("作業").Cells.Clear
lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 1 To lastrow
If Worksheets("売上明細").Cells(i, 1) <> txtDenno.Text Then
For k = 1 To 12
Worksheets("作業").Cells(j, k) = Worksheets("売上明細").Cells(i, k)
Next
j = j + 1
End If
Next
'売上明細に移行
'売上明細シートクリア
lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 1 To 12
Worksheets("売上明細").Cells(i, j) = ""
Next
Next
'作業シートを売上明細シート
lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 1 To 12
Worksheets("売上明細").Cells(i, j) = Worksheets("作業").Cells(i, j)
Next
Next
MsgBox "伝票No" & txtDenno.Text & "が削除されました"
Worksheets("メニュー").Select
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub