ビジネスに役立つ講座や交流会を開催
社長・個人事業主からサラリーマン・主婦まで、どなたでも
アベノ塾

ホーム  会場案内  お問合せ

〒545-0052
大阪市阿倍野区阿倍野筋3-12-2
あべのクオレ1F
(ナガセキャリアプラザ アベノ校)
TEL 06-6647-5571

(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