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

ホーム  会場案内  お問合せ

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

(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