無料VBA講座

掲載参考 EXCEL ファイルダウンロード

このファイルは、「仕入伝票入力2.xlsm」と名前を付けて、Eドライブに保存してください。

このファイルは、「加工部品注文データベース.xlsm」と名前を付けて、Eドライブに保存してください。

このファイルは、「契約一覧.xls」と名前を付けて、Eドライブに保存してください。

このファイルは、「仕入先データベース.xlsm」と名前を付けて、Eドライブに保存してください。

このファイルは、「買掛金用転送データ.xlsm」と名前を付けて、Eドライブに保存してください。

このファイルは、「当月日付基準.xls」と名前を付けて、Eドライブに保存してください。

尚、すでにEドライブに保存してある場合は必要ありません。

■経理用シート

　
　これは経理用に転送するためのシートである。経理では、仕入先別の支払額が必要で
　あるから、月の集計が完了すると転送する必要がある。

この表は ERR が出て、エラーを表示している。請求額と当月仕入額に 3600円の差額が
出ているが、これは[部品本日入力]シートにまだ、当月仕入の登録していない分が残って
いるからである。

　このボタンを押せば、マクロが実行されて間違いがあれば更新される。

　現在は経理用シートの H4 の[チェック]に 3600円が入っているので、集計が途中であり
　本日分の仕入が登録されていないので Exit Sub になるが、終了していると E ドライブの
　買掛金転送データ. xlsm にデータが転送される。

　　

　Workbooks. Open Filename:= "E:\仕入先データベース. xlsm"

　Windows("仕入伝票入力2. xlsm"). Activate
　Range("B3:C500"). Select
　Selection. Copy
　Windows("仕入先データベース. xlsm"). Activate
　Range("B3"). Select
　ActiveSheet. Paste
　　　　' 追加した仕入先登録表をコピーして、仕入先データベースに転記している。

　このボタンは、仕入先データベースの仕入先一覧をコピーして、ここに転記している。

　Workbook. Open Filename:= "E:\仕入先データベース. xlsm"
　Windows("仕入先データベース. xlsm"). Activate
　Sheeta("仕入先一覧"). Select
　Range("B3:C500"). Select
　Selection. Copy
　Windows("仕入伝票入入力2. xlsm"). Activate
　Sheets("仕入先登録"). Select
　Range("B3"). Select
　ActiveSheet. Paste

※仕入先の更新は、menu シートの[部品仕入　入力]ボタンを押した時には[自動仕入先更新]と
　言うマクロを実行して更新している。ここでは手動で更新ができる。

　H ボタンによる、操作説明のフォームの表示
　Sub 仕入先更新ヘルプ( )
　　　仕入先更新. Show vbModeless　　　' 仕入先更新と言うフォームを表示する。
　End Sub　　　　　　　　　　　　　　　 ' フォームが出ている時でも画面移動が可能

　Sub 追加登録ヘルプ( )
　　　追加登録. Show vbModeless　　　　' 追加登録と言うフォームを表示する。
　End Sub

　　

■仕入先別金額シート

　
　これが仕入先別に仕入金額を集計した表である。
　本日仕入額は、[計算2]シートより関数で取得し、前日までの仕入額は[計算1]より関数で
　取得している。

■仕入先登録シート

　これは[仕入先登録]シートである。新規の仕入先登録も、他で変更された内容等も更新できる。
　仕入入力をする時に、新しい仕入先でコードNoが登録されていない時に、ここから新規の
　登録ができる。この表の中に追加仕入先を C 列に書き込み[追加登録]ボタンを押す。

■計算1シート

　これがすべての関数集計を表示している表である。
　上の表は、本日入力分の機種別と仕入先コード分類を示している。
　下の表は、当月仕入分の機種別と仕入先コード分類を示している。
　表内は、すべて関数でデータを取得している。
　仕入日報は、この数値を関数で受けて作成されている。

■計算2シート

　本日入力の仕入先別分類金額は、[計算2]シートの関数表で取得している。

　=DSUM(部品本日入力!$B$3:$N$5008, 部品本日入力!$M$3, C4:C5)
　が D5 セルに書いてある関数である。

　[部品本日入力]シートの B3 から N5008 の範囲を、[計算2]の C4 から C5 の CODE1 で、
　M3 の金額を DSUM 算出する。

■部品本日入力シート

　これは、本日入力したデータが[部品本日入力]シートに転記されたものである。

　[加工仕入]の入力画面にも、本日入力して[仕入月合計データ]に転記していない金額が、
　表示されていて注意を促している。

　
　[部品本日入力]シートの右側に自動集計関数表がある。

　これが[仕入日報]である。[本日入力]分も、[仕入月合計]分もすべて表示されている。

　本日入力分は、日計欄に表示される。　

ワークシート関数の DSUM を使用して、[仕入月合計データ]シートの項目ごとの集計を
自動で行って、他のシートの表内データとして使用している。
ワークシート関数は、データの入力と同時に集計が完了しているので非常に便利である。
DSUM 関数の形式は、V5:X5 までのように配置が決まっているので、VBAコード内に
記入するには適していないので、このように別の集計表を作成して抽出することになる。
その代わり、集計データが正しいか確認するための、合計値の比較もできるから良い。
S4 セル内の関数は、
　= DSUM($B$3:$N$9771, $M$3, V4:X5)
となり[仕入月合計データ]のデータ全体を選択し、M3 の[金額]を算出項目として、V5 の
AA 製番の CODE が 22 以下で 0 以上の合計値を算出する。

Dim strSei (0 To 12) As String 　　　　' strSei(0) から strSei(12) までを使用する宣言。
strSei(0) = "AA"
strSei(1) = "AB"
strSei(2) = "BB"
strSei(3) = "BC"
strSei(4) = "DD"
strSei(5) = "EE"
strSei(6) = "EB"
strSei(7) = "FF"
strSei(8) = "GG"
strSei(9) = "HH"
strSei(10) = "LL"
strSei(11) = "MM"
strSei(12) = "CC"

strN = Left(ActiveCell, 2)　　　　　　　　　　　' 製番セルの左2文字を strN に代入する。
For i2 = 0 To 12　　　　　　　　　　　　　　　 ' strSei(i2) の i2 を 0 から 12 まで strN と比較
　　If strN = strSei(i2) Then GoTo Jump1　　　' して合致すれば、Jump1 へジャンプする。
Next

' 経費も左側の P-1から P-4 を比較して合致が無ければエラーになる。
strSei(0) = "P-1"
strSei(1) = "P-2"
strSei(2) = "P-3"
strSei(3) = "P-4"

■部品データ不足自動チェック3

　 If intN = enpty Then GoTo Jump4　　　' 次のチェック分岐へ
　If intN= 1 Then GoTo Jump1　　　　　 ' 製番列の不良表示処理
　 If intN= 2 Then GoTo Jump2　　　　　 ' 金額列の不良表示処理
　If intN= 3 Then GoTo Jump3　　　　　 ' コード列の不良表示処理

　If Cells(4, 14) = "" Then Cells(4, 14). Value = "A"
　　' 4行目の 14列目はコード列で、4行目の場合は空白行にする場合もあるので、空白行では
　　' いけないので、Aを書いておく。
　For i = 4 To cend
　　　Range("N" & i). Select
　　　If ActiveCell. Value = "A" Then GoTo JumpNext　　' 4行目は無視する。
　　　If ActiveCell. Value = "" Then　　　　　　　　　　　' 5行目から調べて、空白なら
　　　　　ActiveCell. Offset(1, 0). Select　　　　　　　　 ' 現在の一つ下のセルを選択し
　　　　　intAdd = ActiveCell. Row　　　　　　　　　　　' intAdd に行番号を代入する。
　　　　　タイトル = "コード列の不良表示"
　　　　　スタイル = vbvbCritical
　　　　　メッセージ = intAdd & "行目を修正せよ"　　　　' intAdd行目を修正せよと表示
　　　　　MsgBox メッセージ, スタイル, タイトル　　　　　' メッセージを表示する。
　　　　　GoTo JumpEnd
　　　Else　　　　　　　　　　　　　　　　　　　　　　　 ' コードが空白でなかったら
　　　　　intCod = ActiveCell. Value　　　　　　　　　　 ' セルのコード番号を intCod に代入
　　　　　intRowC = Worksheets("仕入先登録"). Range("B3:B500"). End(xlDown). Row
　　　　　Set myRange = Worksheets("仕入先登録"). Range("B3:B" & intRowC) _
　　　　　　. Find(What := intCod, LookAt := xlWhole)
　　　　　　　　　' B3からB500まで intCod を検索して、存在すれば myRangeに代入する

　　　　　If myRange Is Nothing Then　　　　　　　　　　' myRange が空白なら
　　　　　　　タイトル = "コード列の不良表示
　　　　　　　スタイル = vbvbCritical
　　　　　　　メッセージ = i & "行目を修正せよ"　　　　　　' For i = の i 行目を修正せよと表示
　　　　　　　MsgBox メッセージ, スタイル, タイトル　　　 ' MsgBox の表示
　　　　　　　Set myRange = Nothing　　　　　　　　　　 ' 変数の開放
　　　　　　　GoTo JimpEnd
　　　　　End If

　　　　　

　　　※　検索の行移動は、ActiveCell. Offset(1, 0). Select でセルを一つ下へ移動している。

■部品データ不足自動チェック2

If Worksheets("Check"). Range("N4"). Value <> enpty Then _
　intN = Worksheets("Check"). Range("N4"). Value
　　' Checkシートの N4は製番行数と金額行数とコード行数を比較して、1、2、3、が入る。
　　' N4 が空白でなかったら 1 か 2 か 3 が intN に代入される。

If Worksheets("Check"). Range("N5"). Value <> enpty Then _
　intN2 = Worksheets("Check"). Range("N5"). Value
If intN + intN2 = enpty Then　　　　　　　' どれものが 0 なら次のチェックをする。　　

Sheets("仕入月合計データ").Select
Cells(9000, 12).Select　　　　　　　　' 左から 12列目の 9000 行を選択する。
Selection. End(xlUp). Select　　　　　' 下から上へ調べて、最終データ行を選択する。
cend = Mid(ActiveCell. Address, 4)　　' cend 変数にセル番号を代入する。

Cells(4, 2). Select　　　　　　　　　　 ' 左から 2列目の 4行目を選択する。
For i = 4 To cend
　　If ActiveCell. Value = " " Then ActiveCell. ClearContents　　' セルの値が半角スペアーなら
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' セルの内容を消去する。
　　If ActiveCell. Value = "　" Then　　　　' セルの値が全角スペアーなら
　　　　ActiveCell. ClearContents　　　　　' セルの内容を消去する。
　　　　ActiveCell. Offset(1, 0). Select　　　' 現在のセルの、同じ列の一つ下のセルを選択する。
　　Else
　　　　ActiveCell. Offset(1, 0). Select
　　End If
Next

●仕入伝票入力で間違いや、入力漏れが発生して、仕入月合計データに保存されたらどうなるのか、
　

　上記は、仕入月合計データシートに、製番間違いが発生した場合。(製番は DD-1234が正しい)

　

　
　Checkシートに「部品データの製番にERR」、機種分類合計にも「ERR」と表示され
　同時に合計の差額 13 が表示れる。だから13円の間違い個所を探すと処理が早い。
　
　

　　仕入月合計データシートに金額の無い箇所が発生した場合。

　

　
　　Checkシートに「部品データの金額に ERR」、「部品データコードに ERR」、転送デー不良が
　発生と表示される。これは製番に対して金額かコードがおかしい事を示している。
　
　

　　エラーは menu シートのも表示されている。データの間違い箇所を探す為のボタンが
　　[AutoCheck] である。
　

　　ボタンを押すと[金額列不良表示] ダイアログが [仕入月合計データ] シートの間違い行を
　　示してくれる。
　

　
　　これは、製番間違いも、コード番号の入力忘れも抽出して、間違い行を教えてくれる。

●Checkシートの日付確認項目
　1. 今日の日付と何月か確認
　2. 当月日付基準に示されている、当月の日付を確認
　3. 当月日付基準に示されている、当月の日付の月末日を確認
　4. 今日の日付が、当月日付基準に示されている、当月の日付の月末日を過ぎているか確認
　5. 当月の仕入入力を終了したか確認
　6. 今日が月末日の前か後か確認

　※ 尚、月末日は月が替わっても自動で表示される。
　　E39 の関数　　='E:\[当月日付基準.xls] Sheet1' ! $A$2　　　2021
　　E40 の関数　　='E:\[当月日付基準.xls] Sheet1' ! $B$2　　　2
　　E42 の関数　　=E39 & "/" & E40　　　　　　　　　　　　　2021/2
　　C38 の関数　　=EOMONTH(G42, 0)　　　　　　　　　　　 28

●Checkシートのデータ確認項目
　1. 仕入日報シートの表合計欄の縦横計算の合致
　2. 仕入月合計データシートの合計値と機種分類合計値の合致
　3. 仕入月合計データシートの合計値と、Eドライブに保存の転送データ保存ファイルの金額との合致
　4. 仕入月合計シートのデータの、製番行数、金額行数、仕入コード行数の合致
　　経費合計データシートの製番行数、金額行数、仕入コード行数の合致
　5. 本日仕入データが、仕入月合計データシートに転送されたのを確認
　

　
　[当月分入力]のボタンを押せば、「当月分入力できます」と表示され、今日の日付が 2021/2/28 で
　当月分の残りが入力できる。

　

　[来月分入力]ボタンを押せば、「来月分入力できます」と表示され、[来月分加工品入力]と文字が替わり
　[一枚保存]のボタンも色が変わり、今日の日付も 2021/3/3 に変更される。
※保存データは、当月分は[部品本日入力]シートに保存され、来月分は[来月分仮入力]シートに保存される。

※注文データベースの R 列に、仕入入力すると●が記入される。これは製番別に注文部品の
　入荷進捗状態を知りたい時に、注文データベースから製番の注文部品を抽出したときに、
　入荷済と未入荷を判別するためのものである。

●当月と来月の区別
　仕入伝票の当月分の仕入と、来月分の仕入の区別は重要なことである。
　なぜなら仕入額は、仕入先に当月分として支払う金額だからである。
　この仕入処理は、月末締め切りの設定である。毎月末日が当月と来月の区切りの日になる。
　しかし実際は、納品伝票を納入日に仕入処理できなくて、月初めになる場合がある。
　だから、当月と言うのは、締切処理をしようとしている月のことで、今日の日付の月では
　ないことになる。このシステムでは、[当月日付基準.xls]と言うファイルを使用している。

Windows("仕入伝票入力 2.xlsm"). Activate
Sheets("加工仕入"). Select
strMon = Range("G7")　　　　　　　　' G7 の日付を strMon に代入する。
strM = Mid(strMon, 6, 2)　　　　　　　' strMon の左から 6個目を二桁、これは 02 になる。
strD = Mid(strMon, 9, 2)　　　　　　　' strMon の左から 9個目を二桁、これは 28 になる。

For i = intRow + 1 To intRow2
　　Range("N" & i). Value = strM
　　Range("O" & i). Value = strD
　　Range("R" & i).Value = "●"　　　' 注文データベースの R列に●を書いている。
Next

' R5 には関数が入っている。
= If(R6=0,"D7:G7", "D7:G" & R6+6)　　　　　' R6 が 0 なら D7:G7 が入り、0 で無かったら
　　　　　　　　　　　　　　　　　　　　　　　 ' D7:G (R6 は 3 だから 6 加算して 9 ) G9が入る。
　　　　　　　　　　　　　　　　　　　　　　　 ' D7からG9までデータが入力されたことを示す。
　　　　　　　　　　　　　　　　　　　　　　　' R6 には関数が入っていて、入力行数が表示される。

' これは、注文データを使用しないで、手入力したものをカウントしている。
Sheets("menu").Select　　　　　　　　　　' menu の空き部分を使用して表示している。
Range("I13"). Value = [I13] + 1　　　　　' I13 の値に 1 を加算している。

' これは、注文番号が無記入の仕入データをカウントしている。
Sheets("加工仕入"). Select
If Range("D4") = "" Then
　Sheets("menu"). Select　　　　　　　　' menu の空き部分を使用して表示している。
　Range("I14"). Value = [I14] + 1
--------------------------------------------------------------------------------------------------

If Range("D7") = "" Then Exit Sub　　　' D7 が空白なら終了。
If Asc(Left(Range("D7"), 1)) > 90 Or Asc(Mid(Range"(D7"), 2, 1)) > 90 Or _
　Left(Range("D7"), 1) = "P" Or Left(Range("D7"), 1) = " " Then GoTo JumpErr

　' D7 の数値の左から一つ目の文字のコード番号が 90 以上か、二文字目から一つ目の文字
　' コード番号が 90 以上か、一文字目が P か、一文字目が空白ならジャンプする。
　※文字コード番号は、 65 から 90 まではアルファベットの大文字なので、90 以上は違うから
　　エラーになり、左先頭文字が P なら経費の番号だからエラーになる。
---------------------------------------------------------------------------------------------------------
Sheets("加工仕入").Select
If Range("D4") = "" Then　　　' 注文書Noがあるということは、契約一覧に製番があると言う事に
　For i = 7 To 14　　　　　　　 ' なるので、注文書Noが無い場合は調べる必要がある。
　　If Range("D" & i) <> "" Then 　　　　' Di が空白でない場合は、
　　　strSeib = Range("D" & i)
　　　Set appExcel = GetObject("E:\契約一覧.xlsm")　　　　　　　' ファイルを開かないで調べている。
　　　Set myRange = appExcel. Worksheets("商品別"). Range("N6:N5000"). Find(strSeib)
　　　　　　　　　　　　　　　　　　' 契約一覧の N6 から N5000 に strSeib があれば myRange に入る。
　　　If myRange Is Nothing Then　　　　　　　　　　　　　　　　' myRangeが空白なら
　　　　appExcel. Close　　　　　　　　　　　　　　　　　　　　　 ' 変数をクリアしている。
　　　　Set appExcel = Nothing
　　　　Set myRange = Nothing
　　　　MsgBox i & "行目製番エラー修正せよ", vbInfomation, "製番確認"　　　' メッセージを表示する。
　　　　Exit Sub
　　　End If
　　　appExcel. Close　　　　　　　　　' 表示されていないが、ファイルは開いているので閉じる。
　　　Set appExcl = Nothing　　　　　 ' 変数の開放
　　　Set myRange = Nothing
　　End If
　Next
End If
-------------------------------------------------------------------------------------------------------------------

Sub 加工日付転記( )
　　Sheets("加工仕入"). Select
　　ActiveSheet. Unprotect
　　If Range("R6") = 1 Then GoTo Jump1
　　If Range("R6") = 2 Then GoTo Jump2
　　If Range("R6") = 3 Then GoTo Jump3
　　If Range("R6") = 4 Then GoTo Jump4
　　If Range("R6") = 5 Then GoTo Jump5
　　If Range("R6") = 6 Then GoTo Jump6
　　If Range("R6") = 7 Then GoTo Jump7
　　If Range("R6") = 8 Then GoTo Jump8
　　If Range("R6") = 0 Then GoTo JumpEnd
Jump1:
　　Range("L2"). Select
　　Selection. Copy
　　Range("G7"). Select
　　Selection. PasteSpacial Paste: =xlPasteValuesAndNumberFormats, Operation: = _
　　　xlNone, SkipBlanks: =False, Transpose: = False
　　GoTo JumpEnd
Jump2:
　　Range("L2"). Select
　　Selection. Copy
　　Range("G7:G8"). Select
　　Selection. PasteSpacial Paste: =xlPasteValuesAndNumberFormats, Operation: = _
　　　xlNone, SkipBlanks: =False, Transpose: = False
　　GoTo JumpEnd
Jump3:
　　Range("L2"). Select
　　Selection. Copy
　　Range("G7:G9"). Select
　　Selection. PasteSpacial Paste: =xlPasteValuesAndNumberFormats, Operation: = _
　　　xlNone, SkipBlanks: =False, Transpose: = False
　　GoTo JumpEnd
Jump4:　同じ構文なので下部省略します。

　　' 下記表の R6 が 3 だから Jump3 へジャンプする。
　　' L2 は本日の日付を表示しているので、それをコピーしてG7 から G9 へ値だけ貼り付けしている。

※加工仕入シートの右部の表は、関数が入っているので入力や動作をしたときに、すぐに結果を映えして
　くれたり、プログラムで算出した数値などを、次のプログラムモジュールに受け渡すときの記録用に
　便利である。

　

　Windows("加工部品注文データベース.xlsm"). Activate
　Sheets("Sheet1"). Select
　Range("B1:B8"). Select
　Selection. Copy

　Windows("仕入伝票入力 2.xlsm"). Activate
　Sheets("加工DT抽出"). Select
　Range("R6"). Select
　ActiveSheet. Paste 　　　　　　　　　　' 行番号が R列に転記される。
　Range("A1"). Select

　Windows("加工部品注文データベース.xlsm"). Activate
　Sheets("加工DT"). Select
　ActiveSheet. AutoFilterMode = False 　' フィルターモードを解除する。
　Application. CutCopyMode = False 　　' コピーモードを解除する。
　Range("A1"). Select

　Call 加工DT抽出より転記　　　　　　　' サブマクロの実行加工DT抽出から加工仕入画面に転記する。
　Call 加工日付転記

　Windows("加工部品注文データベース.xlsm"). Activate
　ActiveWorkbook. Saved = True 　　　　' ファイルを保存する。
　ActiveWorkbook. Close　　　　　　　　 ' 閉じる。

　Windows("仕入伝票入力 2.xlsm"). Activate
　Sheets("加工仕入"). Select
　Range("A1"). Select
　Application. ScreenUpdating = True　　' 画面固定を解除する。
　Run " 実行中表示 2"　　　　　　　　　　' サブマクロの実行　実行中表示を非表示にする。
End Sub

●[Call 加工日付転記] は加工仕入のデータ行に納入日を入れるためのもので、本日の日付が入るのだが、
　当月分の入力が締め切り日に遅れている場合もあるので、遅れている場合は前月分の最終日が入ることに
　なるので、Todayとは限らない。

Range("$B$6:$S$10000"). Select　　　　　' フィルター結果が消えるまでに、データを右側へ
Selection. Copy　　　　　　　　　　　　　　' コピーしておく
Range("V6"). Select
ActiveSheet. Paste
Application. CutCopyMode = False
ActiveSheet. AutoFilterMode = False
Range("V6:AK13"). Select　　　　　　　　 ' そのデータを加工DT抽出に転記する。
Selection. Copy

Windows("仕入伝票入力 2.xlsm"). Activate
Sheets("加工DT抽出"). Select
Range("B6"). Select
ActiveSheet. Paste　　　　　　　　　　　　' 抽出データが加工DT抽出に転記される。
Range("A1"). Select

SB = WorksheetFunction. Subtotal(9, Range("I6:I12000")) 　　　' SBにはI列の数値合計 3が入る
If SB=0 Then GoTo JumpEnd　　　' これは抽出結果があると言うことで、無ければ JumpEnd へ移動する。

i=1 　　　　　　　　' フィルター結果のデータ行番号記憶
For Each FilterRow In Worksheets("加工DT"). Range("B5"). CurrentRegion. Resize(, 1). _
　SpecialCells(xlVisible)
　If FilterRow. Row ＞ 5 Then　　　　' フィルター結果の B5 の下の行番号を抽出行数は 3 なので、
　　intR(i) = FilterRow. Row 　　　　' intR(1) から intR(3) までの行番号が入る。

　　Worksheets("Sheet1"). Range("B" & i ). Value = intR(i)　　' それを Sheet1 に順に記入する。
　　i = i + 1
　End If
Next FilterRow

----------------------------------------------------------------------------------------------------------------
Sub ファイルが他使用の為待機加工( )
Jump:
　　Workbooks.Open Filename:="E:\加工部品注文データベース.xlsm"
　　With ActiveWorkbook
　　　　strF = .ReadOnly　　　　' 開いたファイルが読み取り専用なら
　　　　If strF = .True Then
　　　　　　Windows("加工注文データベース.xlsm").Close False
　　　　　　一時停止 = MsgBox("しばらくお待ちください") ,vbInformation ,"ファイル他で使用中")
　　　　　　PauseTime = 3 　　　' 3秒間
　　　　　　Start = Timer
　　　　　　Do While Timer ＜ Start + PauseTime
　　　　　　Loop
　　　　　　GoTo Jump 　　　　　' ファイルを閉じて、先頭に戻り開き直す。
　　　　End If
　　End With
　　ActiveSheet. AutoFilterMode = False
End Sub
　　' 他のPCがファイルを開いていると、読み取り専用で開くことになるので、それを見て
　　' 他が閉じるまで待機する。
-----------------------------------------------------------------------------------------------------------------
Windows("加工部品注文データベース.xlsm").Activate
Sheets("加工DT").Shlect

Range("B5:Q10000").Select
Selection. AutoFilter
ActiveSheet. Range("$B5:$Q$10000").AutoFilter Field:=16, Criteria1:= strCyu

●このシステムは、部品と同時に納品書が仕入先から納入されるので、その納品書のデータ保存と集計をする
　ものである。納品書のデータは[注文書作成]で入力した注文データが各[注文書データベース]に保存されている
　ので、それを呼び出して入力画面に書き出し、手入力時間を削減している。
　又、入力と同時に加工部品、市販購入部品、材料、経費の分類と機種別の仕入日報が作成される。
　仕入データは[仕入データベース]に保存されて、他のPCからも参照できる様になる。
　月末には仕入先別に仕入金額の集計結果を経理へ転送している。
　保存データを基に製番ごとの商品原価を集計することもできる。