Top > 販売管理> 売上伝票(登録)

VBA通信教材申込み

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

申込 ヤフーショッピング

売上伝票


(2)売上伝票(登録)

売上伝票プログラム

伝票形式で入力します。
売上金額の計算は数量×販売単価
F8セルに=D8*E8を入力します。
合計はF12セルに=SUM(F8:F11)を入力して計算します。
得意先名を入力するときはVLOOKUP関数を使って入力します。
シートの中に計算式が入力されていますのでシートの保護をしておけば消えることはないですが、得意先名・商品名が増えた場合VLOOKUP関数の範囲を変更しないといけません。
一番のポイントは売上伝票を売上明細シートに累積する場合コピーする作業が面倒になってきます。
IT化は大量のデータが集まってこそ効果が発揮できます。
それを伝票ボタンをクリックするだけで正しく売上明細に蓄えるためにVBAを使います。

伝票登録

売上伝票プログラム

売上伝票登録はVBAではコピー機能を使います。
売上伝票シートと売上明細シートの2枚のシートを使いますのでコピー元コピー先をつかむことがポイントです。
今回伝票登録ボタンと売上登録プログラムを売上伝票シートに記入しますので売上伝票シート名は省略します。
もちろん省略しなくても大丈夫です。
売上伝票Noであれば
Worksheets("売上明細").Cells(i + j, 1) = Cells(1, 5)
このようになります。
売上伝票Noは1行5列のセルで固定ですが、売上明細はどんどんデータが蓄積されますので変数iとjを使っています。
登録後次の売上伝票を入力するためにクリアしています。
そして次の売上伝票Noを再度売上明細の最後の番号を調べて1を加算しています。
今登録した番号を1加算しても同じです。
Sub 売上登録()
  Dim i As Long
  Dim j As Long
'最終行を見つける
  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
'伝票のデータをクリアにする
  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) = ""
  i = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  Cells(1, 5) = Worksheets("売上明細").Cells(i, 1) + 1
End Sub

得意先検索

売上伝票プログラム

得意先コードを入力してエンターキーを押すと得意先名が表示されます。
エクセル関数をVBAで置き換えるを参考にしてください。
プログラムを売上伝票シートに記入していますので、セルの変化を認識するイベントWorksheet_Changeを使います。
引数に得意先コードの座標値4行列をif文で使っています。
1回しか使わないのであまり意味がないと思いますが今回は得意先検索を敢えて関数で作りました。
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim m得意先名 As String
  Dim m得意先cd 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
  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

商品名検索

売上伝票プログラム

4行分すべてTargetを使っています。
同じパターンですので1つにまとめることもできると思いますが、結果を出すことが大事ですから4行分書いています
同じ検索を使う時は関数にした方が便利です。
売上金額の計算は引数を使いませんのでプロシージャを使っています。
call keisanで呼び出しています。
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

伝票印刷

売上伝票プログラム

Sub 伝票印刷()
  Worksheets("売上伝票").PrintPreview
End Sub
プレビュー画面を出さずに印刷する場合は
Worksheets("売上伝票").PrintOut
伝票画面クリア
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) = ""
  i = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  Cells(1, 5) = Worksheets("売上明細").Cells(i, 1) + 1
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

得意先商品名移行

売上伝票プログラム

売上伝票入力を使わず直接売上明細シートに入力した場合の方が生産性があがる場合があります。
特に同じパターンであればコピーして変更部分を訂正する方が早いです。
その時得意先名・商品名を再度入力しますと遅くなり、ミスが起こりやすくなります。
そのために一括で得意先商品名移行するプログラムを考えました。
訂正したい部分だけをプログラム化することは難しいので、すべてを再度変更します。
ここが人間とコンピュータの違いです。
簡単にして結果をだすことを優先的に考えましょう。
売上伝票に得意先名・商品名を移行する場合は得意先コードにて得意先名が異ならない前提であります。
商品のようにその時によって商品名が異なる場合は商品名が自動で変わってしまうと困る場合があります。
Sub 売上得意商品名移行()
  Dim i As Long
  Dim j As Long
  Dim lastrow As Long
  Dim lastrow1 As Long
'得意先名の移行
  lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  lastrow1 = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    For j = 2 To lastrow1
      If Cells(i, 3) = Worksheets("得意先").Cells(j, 1) Then
        Cells(i, 4) = Worksheets("得意先").Cells(j, 2)
        Exit For
      End If
    Next
  Next
'商品名の移行
  lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  lastrow1 = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    For j = 2 To lastrow1
      If Cells(i, 5) = Worksheets("商品名").Cells(j, 1) Then
        Cells(i, 6) = Worksheets("商品名").Cells(j, 2)
        Exit For
      End If
    Next
  Next
End Sub
仕入金額・粗利計算
売上伝票登録時仕入金額・粗利計算をした方がよいかもわかりませんがあえて外しました。
業務の内容によって一番よい方法でシステムを作っていってください。
各種集計業務の時は計算しておかないといけません。
Sub 単価移行金額計算()
  Dim i As Long
  Dim j As Long
  Dim lastrow As Long
  Dim lastrow1 As Long
'単価の移行
  lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  lastrow1 = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    For j = 2 To lastrow1
      If Cells(i, 5) = Worksheets("商品名").Cells(j, 1) Then
        Cells(i, 8) = Worksheets("商品名").Cells(j, 6)
        Cells(i, 10) = Worksheets("商品名").Cells(j, 5)
        Exit For
      End If
    Next
  Next
'金額計算
  lastrow = Worksheets("売上明細").Cells(Rows.Count, 1).End(xlUp).Row
  For i = 2 To lastrow
    Cells(i, 9) = Cells(i, 7) * Cells(i, 8)
    Cells(i, 11) = Cells(i, 7) * Cells(i, 10)
    Cells(i, 12) = Cells(i, 9) - Cells(i, 11)
  Next
End Sub

先頭へ

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