Top > 販売管理> 売上伝票訂正

VBA通信教材申込み

VBA課題解決型実践塾セミナー内容

申込 ヤフーショッピング

売上伝票訂正


(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 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
'伝票のデータをクリアにする
  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

先頭へ

塾長あいさつ
基本方針(考え方)
通信教育内容
課題解決セミナー内容
初心者基礎コース内容
カリキュラム・料金
案内地図・各種リンク
問合せ・申込み
アベノ塾
システムの内製化
アサイコンピュータACS
応用部品集(有料)
販売管理(事例)
財務管理(事例)
顧客管理(事例)
見積もり(事例)
給与(事例)
介護(事例)
ゴースト暗算(事例)
部品集(部品の基礎)
部品集(シート関連)
部品集(データベース)
部品集(セル関連)
部品集(関数)
部品集(フォーム関連)
部品集(ブック関連)
部品集(その他)
変数の勉強
繰り返しと条件文
マスター登録.訂正.削除
フォルダー内のファイル
項目をシート名で作成
ブックの操作
CSVファイルの取り込み
呼び出し元・先
商品マスター検索
エクセル関数をVBAで
エクセル関数を使う
よくつかうプログラム
販売管理(ソース)
財務管理(ソース)
給与管理(概要・画面)
見積もり(概要・画面)
工程管理(概要・画面)
原価管理(概要・画面)