Excel VBAデータベースシステム入門
出荷処理の機能として2つあります。またその中に複数の機能があります。
1.未出荷受注残全検索
未出荷の受注を表示する。
1.1受注残テーブルより未出荷の検索
1.2在庫数の表示
2.出荷
出荷処理する。(在庫がある場合)
2.1出荷帳票の作成
2.2受注残テーブルへの出荷実績の登録
2.3在庫入出庫テーブルへの出庫実績の登録
2.4在庫数の再表示
順に製作していきます。
1.1受注残テーブルより未出荷の検索
受注残テーブルの検索プログラムはすでに作成済みです。
未出荷のみ表示するよう製作します。赤色部修正。
|
Sub 未出荷受注残全検索() Application.Calculation = xlManual Sheets("受注残").DrawingObjects("sql").Characters.Text = "出荷日 IS NULL"
'フィルタ解除 Set BK = ActiveWorkbook Set INS = BK.Sheets("受注残") '入力出力シート If INS.AutoFilterMode Then INS.Range("$A2").AutoFilter End If 受注残データベース検索高速貼付 受注残旧データ式コピー
EN = INS.Range("$A65536").End(xlUp).Row
Application.Calculation = xlAutomatic End Sub |
リストを品目コード、受注日順にします。赤色部修正。
|
Sub 受注残データベース検索高速貼付2() '追加貼り付け Dim rst As Object Dim NewDB As Object Dim BK, OUS, STRSQL, CNT, OU Set rst = CreateObject("ADODB.Recordset") Set NewDB = CreateObject("ADODB.Connection") 'Application.DisplayAlerts = False ''メッセージ非表示 Application.ScreenUpdating = False ''画面表示無 Set BK = ActiveWorkbook ''THISWORKBOOK Set OUS = BK.Sheets("受注残") Call dbopen(NewDB) ''データベースとの接続 STRSQL = "SELECT 受注番号,受注日,顧客名,顧客住所,品目コード,数量,品名,単価,金額,出荷日,更新日時 FROM 受注残" STRSQL = STRSQL & " WHERE " & OUS.DrawingObjects("sql").Characters.Text STRSQL = STRSQL & " ORDER BY 品目コード,受注日;" rst.Open STRSQL, NewDB, 3, 1 ''''adOpenStatic, adLockReadOnly CNT = rst.RecordCount ''''件数 OU = OUS.Range("$A65536").End(xlUp).Row + 1 ''5 ''追加出力 Dim MM(1 To 11) If Not (rst.EOF) Then ''データあり？ Do Until rst.EOF For J = 1 To 11 MM(J) = rst.Fields(J - 1).Value Next J OUS.Range("$A" & OU).Resize(, 11).Value = MM OU = OU + 1 rst.MoveNext ''次のデータ Application.StatusBar = OU - 1 & "<-" & CNT + 2 Loop End If rst.Close Set rst = Nothing End Sub |
1.2在庫数の表示
在庫数は在庫テーブルから持ってくるのと同時に、在庫入出庫テーブルも参照します。
本システムでは在庫テーブルは都度更新せず、在庫入出庫テーブルの変化分を加え、在庫を計算する方式を取ります。
(この考え方により、高度なシステムとされる在庫システムを容易に製作できます。)
|
Sub 在庫テーブルキー検索() '在庫数は 在庫データと 在庫入出庫より検索 (在庫データは更新しない) '在庫シートの$A3以下を検索 Dim cmd As Object Dim rst As Object Dim NewDB As Object
Set cmd = CreateObject("ADODB.Command") Set rst = CreateObject("ADODB.Recordset") Set NewDB = CreateObject("ADODB.Connection")
'Application.DisplayAlerts = False 'メッセージ非表示 Application.ScreenUpdating = False '画面表示無
Set BK = ActiveWorkbook 'THISWORKBOOK Set INS = BK.Sheets("受注残") EN = INS.Range("$A65536").End(xlUp).Row
Call dbopen(NewDB) 'データベースとの接続
STRSQL = "PARAMETERS dkey Value;" STRSQL = STRSQL & "SELECT 在庫数," STRSQL = STRSQL & "(SELECT SUM(数量) FROM 在庫入出庫 WHERE 在庫.品目コード=在庫入出庫.品目コード AND 区分=1 AND 在庫更新日 IS NULL)," STRSQL = STRSQL & "(SELECT SUM(数量) FROM 在庫入出庫 WHERE 在庫.品目コード=在庫入出庫.品目コード AND 区分=2 AND 在庫更新日 IS NULL)" STRSQL = STRSQL & " FROM 在庫 " STRSQL = STRSQL & " WHERE 品目コード=[dkey] ;"
cmd.ActiveConnection = NewDB cmd.CommandText = STRSQL cmd.CommandType = 1 ''adCmdText '' For I = 3 To EN cmd.Parameters("dkey") = "" & INS.Range("$E" & I).Value ''キー Set rst = cmd.Execute '''検索実行 If Not (rst.EOF) Then 'データあり？ INS.Range("$L" & I).Value = rst.Fields(0).Value + Val("" & rst.Fields(1).Value) - Val("" & rst.Fields(2).Value) End If Application.StatusBar = I & "<-" & EN Next I On Error Resume Next rst.Close Set rst = Nothing Set cmd = Nothing Set NewDB = Nothing End Sub
|
DBキー検索を使って作成し、赤色部を修正しました。
副問い合わせという方法でSELECT文の中にSELECT文を記入し、その品目の入庫数、出庫数を求めています。
在庫数+入庫数-出庫数を計算し、L列に出力しています。
在庫更新日がNULLでないものは在庫テーブルに反映済みのため集計しません。
2.1出荷帳票の作成
|
Sub 出荷帳票計算式記録出力() ' IN OUT 出荷帳票 I = Sheets("受注残").Range("処理行").Value
Set INS = Sheets("出荷帳票") '入力出力シート INS.Range("$C$5").Value = Sheets("受注残").Range("D" & I).Value INS.Range("$C$6").Value = Sheets("受注残").Range("C" & I).Value INS.Range("$C$9").Value = Sheets("受注残").Range("E" & I).Value INS.Range("$D$9").Value = Sheets("受注残").Range("G" & I).Value INS.Range("$F$9").Value = Sheets("受注残").Range("F" & I).Value INS.Range("$G$9").Value = Sheets("受注残").Range("H" & I).Value INS.Range("$H$9").Value = Sheets("受注残").Range("I" & I).Value End Sub |
選択した行がSheets("受注残").Range("処理行").Valueに入っています。
その行のデータから単純な出荷帳票を作成するマクロを手作成しました。
2.2受注残テーブルへの出荷実績の登録
自動作成されたマクロをそのまま利用します。
実行する前に、出荷実績日欄に日付を記入しておきます。
|
Sub 受注残変更行更新() 'フィルタ解除 Set BK = ActiveWorkbook Set INS = BK.Sheets("受注残") '入力出力シート If INS.AutoFilterMode Then INS.Range("$A2").AutoFilter End If 'Application.ScreenUpdating = True 受注残更新判断式コピー 受注残データベース更新挿入 受注残旧データ式コピー End Sub |
2.3在庫入出庫テーブルへの出庫実績の登録
在庫入出庫シートに出庫データを記入します。
記入後、自動作成された 在庫入出庫テーブル挿入を実行します。
このマクロを手作成しました。品目, 数量をパラメータとして渡します。
|
Sub 出庫追加(品目, 数量) Set OUS = Sheets("在庫入出庫") OUS.Range("A3:IV65536").ClearContents OUS.Range("B3").Value = 品目 OUS.Range("C3").Value = 2 '出庫 OUS.Range("D3").Value = Now '出庫日 OUS.Range("E3").Value = 数量 '出庫数 OUS.Range("G3").Value = Now '更新日
在庫入出庫テーブル挿入 End Sub |
2.4在庫数の再表示
出荷すると在庫が減ります。
在庫数を再計算して表示します。
「1.2在庫数の表示」をもう一度実行します。多少時間を短くするために出荷した品目コードだけを再計算するよう工夫します。
2出荷
出荷のマクロは以上のマクロを順に実行します。
在庫有無チェックなど多少工夫し、下記のように手作成しました。
この中で、在庫テーブルキー検索は検索する行範囲をパラメータで指定できるよう改定しました。
|
Sub 出荷() 行 = Selection.Row Sheets("受注残").Range("処理行").Value = 行 出荷済 = Sheets("受注残").Range("J" & 行).Value If 出荷済 <> "" Then MsgBox ("その行は出荷済みです") End End If 選択セル在庫チェックと出庫追加
出荷帳票計算式記録出力 ' IN 処理行 OUT 出荷帳票 Sheets("出荷帳票").Select End Sub
Sub 選択セル在庫チェックと出庫追加() 行 = Sheets("受注残").Range("処理行").Value 品目 = Sheets("受注残").Range("E" & 行).Value 数量 = Sheets("受注残").Range("F" & 行).Value Call 在庫テーブルキー検索A(行, 行) 'OUT 受注残
在庫 = Sheets("受注残").Range("L" & 行).Value If 在庫 < 数量 Then MsgBox ("在庫数" & 在庫 & " 数量不足のため出荷できません") End End If Call 出庫追加(品目, 数量) Sheets("受注残").Range("J" & 行).Value = Now '出荷日 受注残変更行更新 Call 在庫再表示(品目) End Sub
Sub 在庫再表示(品目) 'この品目の在庫を再表示 品目は連続 EN = Sheets("受注残").Range("A65536").End(xlUp).Row ST = 0 For I = 3 To EN If ST = 0 And 品目 = Sheets("受注残").Range("E" & I).Value Then ST = I '開始 If ST <> 0 And 品目 <> Sheets("受注残").Range("E" & I).Value Then EN2 = I - 1 '終了 Exit For End If Next I Call 在庫テーブルキー検索A(ST, EN2) End Sub |