(4)売上伝票(訂正)
10000件のデータで16秒かかりました。3000件を超えると直接売上明細シートの訂正を使ったほうがよいと思います。
通常データベースは削除フラグだけをつけて処理をしますのでスピードは問題ないです。
VBAでそれをすると処理が難しくなります。
標準モジュールに伝票訂正フォームが開くプロシージャを記述します。
Sub 伝票訂正()
frmTeisei.Show
End Sub
伝票訂正フォーム
伝票訂正は伝票照会と同じプログラムを使って訂正したい伝票を売上伝票訂正シートにコピーして訂正します。
訂正入力の処理は伝票登録と同じです。
訂正したデータをどのように伝票明細に反映させるかがポイントです。
普通に考えると訂正する伝票Noの個所で訂正した個所を上書きすると考えますが、行が追加になったり削除した場合のことを考えるとプログラムが非常に難しくなります。
訂正する伝票を一旦削除して新たに訂正した伝票を追加する方法をとることが多いです。
伝票訂正フォームのオブジェクト名一覧
フォームのオブジェクト名で伝票訂正フォームを作成します。
フォームモジュールに記述しています。伝票照会フォームのプログラムと同じです。
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ボタンをクリックした時
伝票照会と同じです。
シート名が変わるだけです。
Private Sub cmdOk_Click()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim kingaku As Long
'売上伝票訂正クリア
Worksheets("売上伝票訂正").Cells(1, 5) = ""
Worksheets("売上伝票訂正").Cells(2, 5) = ""
Worksheets("売上伝票訂正").Cells(4, 5) = ""
Worksheets("売上伝票訂正").Cells(5, 5) = ""
For i = 1 To 4
Worksheets("売上伝票訂正").Cells(7 + i, 2) = ""
Worksheets("売上伝票訂正").Cells(7 + i, 3) = ""
Worksheets("売上伝票訂正").Cells(7 + i, 4) = ""
Worksheets("売上伝票訂正").Cells(7 + i, 5) = ""
Worksheets("売上伝票訂正").Cells(7 + i, 6) = ""
Next
Worksheets("売上伝票訂正").Cells(12, 6) = ""
Worksheets("売上伝票訂正").Cells(13, 6) = ""
Worksheets("売上伝票訂正").Cells(14, 6) = ""
'売上伝票明細から指定した売上伝票を表示
lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
j = 1
For i = 2 To lastrow
If Worksheets("売上明細").Cells(i, 1) = txtDenno.Text Then
Worksheets("売上伝票訂正").Cells(1, 5) = Worksheets("売上明細").Cells(i, 1)
Worksheets("売上伝票訂正").Cells(2, 5) = Worksheets("売上明細").Cells(i, 2)
Worksheets("売上伝票訂正").Cells(4, 5) = Worksheets("売上明細").Cells(i, 3)
Worksheets("売上伝票訂正").Cells(5, 5) = Worksheets("売上明細").Cells(i, 4)
Worksheets("売上伝票訂正").Cells(7 + j, 2) = Worksheets("売上明細").Cells(i, 5)
Worksheets("売上伝票訂正").Cells(7 + j, 3) = Worksheets("売上明細").Cells(i, 6)
Worksheets("売上伝票訂正").Cells(7 + j, 4) = Worksheets("売上明細").Cells(i, 7)
Worksheets("売上伝票訂正").Cells(7 + j, 5) = Worksheets("売上明細").Cells(i, 8)
Worksheets("売上伝票訂正").Cells(7 + j, 6) = Worksheets("売上明細").Cells(i, 9)
j = j + 1
End If
Next
'合計計算
For i = 8 To 11
kingaku = kingaku + Worksheets("売上伝票訂正").Cells(i, 6)
Next
Worksheets("売上伝票訂正").Cells(12, 6) = kingaku
Worksheets("売上伝票訂正").Cells(13, 6) = kingaku * 0.05
Worksheets("売上伝票訂正").Cells(14, 6) = kingaku * 1.05
Unload Me
Worksheets("売上伝票訂正").Select
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
売上伝票訂正シート
Sub 伝票印刷()
Worksheets("売上伝票").PrintPreview
End Sub
Sub メニュー()
Dim i As Long
Cells(1, 5) = ""
Cells(2, 5) = ""
Cells(4, 5) = ""
Cells(5, 5) = ""
For i = 1 To 4
Cells(7 + i, 2) = ""
Cells(7 + i, 3) = ""
Cells(7 + i, 4) = ""
Cells(7 + i, 5) = ""
Cells(7 + i, 6) = ""
Next
Cells(12, 6) = ""
Cells(13, 6) = ""
Cells(14, 6) = ""
Worksheets("メニュー").Select
End Sub
売上伝票登録と同じです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim m得意先名 As String
Dim m得意先cd As Long
Dim m商品名1 As String
Dim m商品cd1 As Long
Dim m単価1 As Long
Dim m商品名2 As String
Dim m商品cd2 As Long
Dim m単価2 As Long
Dim m商品名3 As String
Dim m商品cd3 As Long
Dim m単価3 As Long
Dim m商品名4 As String
Dim m商品cd4 As Long
Dim m単価4 As Long
With Target
'得意先コードの入力
If .Row = 4 And .Column = 5 Then
If Cells(4, 5) = "" Then
Exit Sub
End If
m得意先cd = Cells(4, 5)
m得意先名 = tkensaku(m得意先cd)
Cells(5, 5) = m得意先名
End If
'商品コード1行目の入力
If .Row = 8 And .Column = 2 Then
If Cells(8, 2) = "" Then
Exit Sub
End If
m商品cd1 = Cells(8, 2)
m商品名1 = skensaku(m商品cd1)
m単価1 = stkensaku(m商品cd1)
Cells(8, 3) = m商品名1
Cells(8, 5) = m単価1
End If
'商品コード2行目の入力
If .Row = 9 And .Column = 2 Then
If Cells(9, 2) = "" Then
Exit Sub
End If
m商品cd2 = Cells(9, 2)
m商品名2 = skensaku(m商品cd2)
m単価2 = stkensaku(m商品cd2)
Cells(9, 3) = m商品名2
Cells(9, 5) = m単価2
End If
'商品コード3行目の入力
If .Row = 10 And .Column = 2 Then
If Cells(10, 2) = "" Then
Exit Sub
End If
m商品cd3 = Cells(10, 2)
m商品名3 = skensaku(m商品cd3)
m単価3 = stkensaku(m商品cd3)
Cells(10, 3) = m商品名3
Cells(10, 5) = m単価3
End If
'商品コード4行目の入力
If .Row = 11 And .Column = 2 Then
If Cells(11, 2) = "" Then
Exit Sub
End If
m商品cd4 = Cells(11, 2)
m商品名4 = skensaku(m商品cd4)
m単価4 = stkensaku(m商品cd4)
Cells(11, 3) = m商品名4
Cells(11, 5) = m単価4
End If
'商品数量1行目の入力
If .Row = 8 And .Column = 4 Then
If Cells(8, 4) = "" Then
Exit Sub
End If
Cells(8, 6) = Cells(8, 4) * Cells(8, 5)
Call keisan
End If
'商品数量2行目の入力
If .Row = 9 And .Column = 4 Then
If Cells(9, 4) = "" Then
Exit Sub
End If
Cells(9, 6) = Cells(9, 4) * Cells(9, 5)
Call keisan
End If
'商品数量3行目の入力
If .Row = 10 And .Column = 4 Then
If Cells(10, 4) = "" Then
Exit Sub
End If
Cells(10, 6) = Cells(10, 4) * Cells(10, 5)
Call keisan
End If
'商品数量4行目の入力
If .Row = 11 And .Column = 4 Then
If Cells(11, 4) = "" Then
Exit Sub
End If
Cells(11, 6) = Cells(11, 4) * Cells(11, 5)
Call keisan
End If
End With
End Sub
Function tkensaku(tokuicd As Long) As String
Dim lastrow As Long
Dim i As Long
lastrow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If tokuicd = Worksheets("得意先").Cells(i, 1) Then
tkensaku = Worksheets("得意先").Cells(i, 2)
Exit Function
End If
Next
MsgBox "得意先はみつかりません"
tkensaku = ""
End Function
Function skensaku(scode As Long) As String
Dim lastrow As Long
Dim i As Long
lastrow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If scode = Worksheets("商品名").Cells(i, 1) Then
skensaku = Worksheets("商品名").Cells(i, 2)
Exit Function
End If
Next
MsgBox "商品名はみつかりません"
skensaku = ""
End Function
Function stkensaku(scode As Long) As Long
Dim lastrow As Long
Dim i As Long
lastrow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
If scode = Worksheets("商品名").Cells(i, 1) Then
stkensaku = Worksheets("商品名").Cells(i, 6)
Exit Function
End If
Next
MsgBox "商品名はみつかりません"
stkensaku = 0
End Function
Sub keisan()
Dim i As Long
Dim kingaku As Long
For i = 8 To 11
kingaku = kingaku + Cells(i, 6)
Next
Cells(12, 6) = kingaku
Cells(13, 6) = kingaku * 0.05
Cells(14, 6) = kingaku * 1.05
End Sub
訂正した伝票を売上明細シートに更新
1)訂正する伝票NOを削除した売上明細データを作業シートに作るために作業シートをクリアします。
2)売上明細シートから訂正する伝票NOを削除した売上明細データを作業シートにコピーします。
3)作業シートの最終行を判断しそのあとに訂正したデータを追加します。
4)作業シートを伝票Noで並び替えします。
5)売上明細シートをクリアし作業シートをコピーします。
6)売上訂正伝票のデータをクリアにしてメニューに戻ります。
Sub 伝票訂正()
Dim i As Long
Dim j As Long
Dim k As Long
Dim lastrow As Long
'伝票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) <> Cells(1, 5) Then
For k = 1 To 12
Worksheets("作業").Cells(j, k) = Worksheets("売上明細").Cells(i, k)
Next
j = j + 1
End If
Next
'訂正伝票を追加
'最終行を見つける
i = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 4
If Cells(7 + j, 2) = "" Then
Exit For
End If
Worksheets("作業").Cells(i + j, 1) = Cells(1, 5)
Worksheets("作業").Cells(i + j, 2) = Cells(2, 5)
Worksheets("作業").Cells(i + j, 3) = Cells(4, 5)
Worksheets("作業").Cells(i + j, 4) = Cells(5, 5)
Worksheets("作業").Cells(i + j, 5) = Cells(7 + j, 2)
Worksheets("作業").Cells(i + j, 6) = Cells(7 + j, 3)
Worksheets("作業").Cells(i + j, 7) = Cells(7 + j, 4)
Worksheets("作業").Cells(i + j, 8) = Cells(7 + j, 5)
Worksheets("作業").Cells(i + j, 9) = Cells(7 + j, 6)
Next
'伝票Noで並び替え
lastrow = Worksheets("作業").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("作業").Sort.SortFields.Clear
Worksheets("作業").Sort.SortFields.Add Key:=Cells(2, 1), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("作業").Sort
.SetRange Range(Cells(2, 1), Cells(lastrow, 12))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'売上明細に移行
'売上明細シートクリア
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
'伝票のデータをクリアにする
Cells(1, 5) = ""
Cells(2, 5) = ""
Cells(4, 5) = ""
Cells(5, 5) = ""
For i = 1 To 4
Cells(7 + i, 2) = ""
Cells(7 + i, 3) = ""
Cells(7 + i, 4) = ""
Cells(7 + i, 5) = ""
Cells(7 + i, 6) = ""
Next
Cells(12, 6) = ""
Cells(13, 6) = ""
Cells(14, 6) = ""
Worksheets("メニュー").Select
End Sub