(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