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

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

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

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

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

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

尚、すでにEドライブに保存してある場合は必要ありません。
この中で使用されている
Excelファイルは最下部から
取得できます。
■経理用シート

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



この表は 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"
■製番間違い自動チェック1


■製番間違い自動チェック2
■部品データ不足自動チェック5
■部品データ不足自動チェック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

 ボタンを押すと、[部品データ不足自動チェック] を実行する。

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


 Call 製番セルの文字なしをクリアする。    ' 製番文字に入っているスペアーを除去する。

■製番セルの文字なしをクリアする
●仕入伝票入力で間違いや、入力漏れが発生して、仕入月合計データに保存されたらどうなるのか、
 

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

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

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

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

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

  ボタンを押すと[金額列不良表示] ダイアログが [仕入月合計データ] シートの間違い行を
  示してくれる。
 
 
  これは、製番間違いも、コード番号の入力忘れも抽出して、間違い行を教えてくれる。


●Checkシートの、仕入月合計データと経費月合計データの入力確認事項
 1. 科目No 文字の入力間違い確認
 2. 科目No の入力忘れ確認
 3. 仕入先コード番号の入力忘れ確認
 4. 金額入力忘れ確認

  
●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. 本日仕入データが、仕入月合計データシートに転送されたのを確認
 


●Check シート

 
 このシートは、このファイルのすべてのデータの行数や合計値、分類エラー、日付、締切、
 Eドライブとのデータの比較などが表示され、エラーが見つかればその場所が表示される。

■来月分仮入力シート
■部品本日入力シート

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

 

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


 [延長] のボタンを押して[加工仕入]シートに移動すると、日付は 2021/2/28 と当月の末日を示している。
 この場合は、当月分も来月分も入力が可能である。

●今日が 3月3日だとするとどうなるのか?


 Menuシートで [部品仕入入力] ボタンを押すと、締切確認フォームが表示される。
 3月3日になってこれが表示されるということは、まだ締め切りが終了していないと言う事で、
 当月分の2月の仕入伝票が残っていると言うことだから、 [延長] のボタンを押すと [加工仕入]
 シートに移動する。[終了]ボタンを押すとファイルを閉じる。
■加工仕入入力シート


 今日の日付が 2021/2/16 の場合[当月分入力] ボタンを押すと 、"当月分入力できます" と表示されて、
 入力が可能になり納入日も今日の日付になる。


  今日の日付が 2021/2/16 の場合[来月分入力] ボタンを押すと、 "1日まで入力できません" と表示さ
  れて入力できない。これは、今日に来月分の納品書があるわけがないので指摘するのである。
■加工部品注文データベース.xlsmの加工DTシート


■加工仕入シート
■当月日付基準.xls の Sheet1

 
このファイルの月は、当月の仕入処理が終わった時に、次の月に変更するので、それまでは
 当月の月が表示されている。だからいつでもこのファイルの月を参照して当月が何月かを確認できる。

※注文データベースの 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
■注文DBに転記加工
■加工部品注文データベースの加工DTシート

 注文書Noを書かないで入力すると、それは注文データベースに無いと言うことになるので、
 書いておかないと注文部品の入荷進捗を調べるときに分からなくなる。
 尚、R列の●印は、仕入入力が行われた事を示し、入荷したことを示す。
■部品本日入力シート

 入力注文書Noが転記されている。
■加工仕入を本日入力へ転記
Sheets("加工仕入"). Select
Range([R5]). Select             ' ここでは、D7:G9 になる。
Selection. Copy
Sheets("部品本日入力"). Select
Range("B" & cend). Select
Selection. PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
  xlNone, SkipBlanks:= False, Transpose:= False     ' 値だけの貼り付け
' 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
--------------------------------------------------------------------------------------------------
 Sheets("部品本日入力").Select
 Range("B4").Select
 cend = Range("B5000"). End(xlUp). Row + 1   ' B 列の最終行番号を cend に代入する。
--------------------------------------------------------------------------------------------------------------------

■Call 一枚保存加工のカウント

■加工仕入を本日入力へ転記
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
-------------------------------------------------------------------------------------------------------------------
■加工仕入を本日入力へ転記

' G5 には、B6 から B7294 までに G4 と同じ値があれば 1 を返す、と言う関数が書かれている。

■加工仕入シートの右部


' W5 には、[仕入入力済]シートの G5 の値が入る関数が書いてある。
■仕入入力済シート
●K3に入力されている関数
 = IF(AND(I7>0,G7=""), "日付未入力", IF(D4="","", IF(W5>0, "納品書がダブリ", IF(U5<1, _
  "注文書 No 間違い",""))))
  
   ' I7 の[数量]が入力されていて、[納入日]が入力されていなければ、"日付未入力" と表示され、
   ' D4 の注文書番号が未入力なら空白、W5 が 1 なら、"納品書ダブリ"と表示する。
   ' U5 が 0 なら"注文書No間違い"と表示される。
■この注文番号はすでに入力されていると、K3 に "納品書がダブリ" と表示される。
■[一枚保存]を押して、本日入力分を[部品本日入力]シートに転記する。
■加工仕入シートの右部

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 へ値だけ貼り付けしている。

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

 
■仕入伝票入力 2.xlsmの 加工仕入シート
 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とは限らない。



■仕入伝票入力 2.xlsm の 加工DT抽出
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

■加工部品注文データベース.xlsm の Sheet1
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
 ' このプログラムを実行すれば、図形が表示されていれば非表示になり、非表示なら表示される。
Windows("仕入伝票入力2.xlsm").Activate
Sheets("加工仕入").Select
Range("U5").Value = 1
strCyu = [D4]        ' strCyu に注文書No.を代入する。[D4]はダイレクトにD4の内容を指す。




■Call ファイルを他使用の為待機加工

図形を選択すると、その番号が上部に表示される。表示位置は、図形を置いた位置になる。

Sub 加工注文書No呼出( )
Run "実行中表示2"   ' " 定位置に実行中と言う図形を表示する。
           ' Runと記述しても、サブプログラムの実行ができる。
           ' マクロを実行している間表示し、終われば消える。
日付はこのボタンを押すと自動入力される。
納品書の注文書Noを見て、それを加工品入力画面の[注文書No]に入力して、
このボタンを押すと、加工品入力画面に注文書内容が表示される。
■それでは、加工部品の仕入伝票を入力手順から見て行きましょう。
■経費入力画面
■材料入力画面
■購入部品入力画面
■加工部品入力画面
■menu画面
●このシステムは、部品と同時に納品書が仕入先から納入されるので、その納品書のデータ保存と集計をする
 ものである。納品書のデータは[注文書作成]で入力した注文データが各[注文書データベース]に保存されている
 ので、それを呼び出して入力画面に書き出し、手入力時間を削減している。
 又、入力と同時に加工部品、市販購入部品、材料、経費の分類と機種別の仕入日報が作成される。
 仕入データは[仕入データベース]に保存されて、他のPCからも参照できる様になる。
 月末には仕入先別に仕入金額の集計結果を経理へ転送している。
 保存データを基に製番ごとの商品原価を集計することもできる。

 
実践コース
仕入処理システム


実際に使っているシステムの内容で解説
  EXCEL VBA 講座