[[20180804193347]] 『重複データと変化する日付の条件』(かなぶん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『重複データと変化する日付の条件』(かなぶん)

こんにちは。
色々なサイトで検索をしたのですが、答えが見つからず質問させていただきました。

野菜の注文データの一覧があります。10000件位
前回納品してから2年以上 間のあく野菜を納品するときは
書類をつけなくてはいけません。

その書類を依頼することに悩んでいます。

重複する野菜の名前の中で最新の出荷日を表示することは出来ました。
その日付と納品予定日を引き算して730日以上なら書類を作成することも分かりました。

問題は、納品前の発送待ちの状態の時重複しているデータを探せないことです。
どんどん注文が入るので、書類をつけて発送する商品が変わってしまうことに対応できません。

 A        B        C         D           E         F          G
 状態    出荷日   商品名    納品予定日   書類有無  最終出荷日 D-Bの日数
 1       7/3      なす      18/7/4       要        7/3           0
                  なす      18/8/4       不要      7/3          30
                  なす      18/9/10      不要      7/3          60
                  なす      22/7/3       要        7/3        1460  

このような表を作っています。
注文が入ると納品予定日順に並び替えています。
野菜はなすだけでなく、きゅうりやトマト等複数あります。

A列は出荷すると1を入れてBからGセルの色を変えています。
2を入れると不良品返品の意味で色をつけています。
返品があっても出荷済みにと同等扱いです。

早めに書類の有無を確認して作成依頼したいのに
出荷する毎に書類の有無が変わってしまうので、
困っています。
重複して依頼すると非効率なので避けたいです。

出荷していないものの重複データから書類の有無を予測する
関数があれば教えてください。

4列目のなすは、あとから注文が入って先納期で出荷すると書類が不要になってしまいます。
(先納期のなすに書類が必要になります)

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 そちらの仕事内容が分からないので、呑み込めない部分があります。

 >その書類を依頼することに悩んでいます。

 1.誰が誰に依頼するんですか?(会社内部の部署間の話ですか?)

 >重複する野菜の名前の中で最新の出荷日を表示することは出来ました。

 2.その手順で表示された最新の出荷日とはB列のことですか? それともF列ですか?
   B列とF列の日付の関係はどうなっているんですか?

 > A        B        C         D           E         F          G
 > 状態    出荷日   商品名    納品予定日   書類有無  最終出荷日 D-Bの日数
 > 1       7/3      なす      18/7/4       要        7/3           0
 >                  なす      18/8/4       不要      7/3          30

 3.何故、D-Bが「30」なんですか? 7/3 → 8/4 「32」だと思うんですが?

 4.予約データと出荷済みデータは同じ列に書いたままなんですか?
   (出荷したら、そのデータは、どこか別の表とか、別の列とかに移動させないんですか?)

 >どんどん注文が入るので、書類をつけて発送する商品が変わってしまうことに対応できません。
 >4列目のなすは、あとから注文が入って先納期で出荷すると書類が不要になってしまいます。 
 >(先納期のなすに書類が必要になります) 

 5.それは、誰がやっても同じですよね?
   計算方法を工夫すれば、対応できる事とは思えませんが・・

 >出荷していないものの重複データから書類の有無を予測する 
 >関数があれば教えてください。

 そう言う関数はありません。
 実存データを使って、その時点における書類の有無を判定するしかできません。

(半平太) 2018/08/04(土) 22:06


半平太さま

お応えありがとうございます。

業務は、お客様から味や形、色などの希望を受けてから野菜を作成します。
実際は野菜ではないですが、例えとして野菜を出しています。
新規のものとリピート品で2年以上間のあいたものには品質保証書をつけることになっています。
その品質保証書添付有無の識別に頭を悩ませています。

ご質問に対してのお返事です。

1、社内で作成部署へ連絡します。
品質保証書のようなものを添付して発送します、
その部署の担当者が1日に作成できる枚数が決まっているので
早めに依頼します。

例えば10月に120件ある場合、前もって準備するためです。
納期に間に合わせるために早めの依頼をします。
変更があれば、変更が決まった時点でお知らせしています。

新規注文が入って、書類有無の変更確認も一苦労しています。

2、出荷するとBに日付を入れていきます。
マックス関数を使ってF列にBの日付をに表示しています。
出荷する毎に日付が変わります。

3、すみません。32です。

4、出荷したらBに日付をいれAに1を入力、色をつけて
並び替えます。同じシートです。
出荷して3年以上経過したものは別シートに移しています。
毎回別シートに移動する手間を省くためです。

5、予約というか注文を受けて出荷までの間の
重複データで、先に注文があるから後の方は添付不要という有無を表示させたい
と思っています。
手作業で行うときも、オートフィルタで商品名で絞って最終出荷日をみて、
それから2年以上経過していないか、
又は新規かどうかを判断して書類の有無を確認しています。

数が多いとフィルターで取り出せないので関数で表示出来ないかと思っています。
countif関数で重複に番号をつけようかとも思いましたが
数式の組み合わせが難しかったです。

うまく説明が出来てなくて申し訳有りません。

(かなぶん) 2018/08/05(日) 04:52


 >変更があれば、変更が決まった時点でお知らせしています。 
 >新規注文が入って、書類有無の変更確認も一苦労しています。

 とにかく、何か変動があれば、再計算せざるを得ないですよね?
 毎回手作業ではとても手間だと思います。

 また、変動前と変動後で保証書作成の依頼内容がどう変わるか分からないと、
 保証書担当者に的確に指示が出せないですよね?

 そうなると、質問冒頭にあった表が旨く出来上がったとしても
 そんなに使い勝手が良いとは思えないのですけども・・

 保証書担当者には何を伝えるべきなのかを整理した方がいいと思います。

 それによって、作成すべき表がどうあるべきなのか見えて来るんじゃないでしょうか?

 いずれにしても、結構面倒な作業になるので、私としてはマクロで解決する方針にしたいです。

 >2、出荷するとBに日付を入れていきます。 
 >マックス関数を使ってF列にBの日付をに表示しています。 
 >出荷する毎に日付が変わります。 

 そう作っているんでしょうが、予定データは全て同じ最終出荷日になりますね。
 でも、この希望があるんですから、そこは前回出荷日(予定日)にしないと的確に判断できないです。
     ↓
 >5、予約というか注文を受けて出荷までの間の 
 >重複データで、先に注文があるから後の方は添付不要という有無を表示させたい 
 >と思っています。 

 なので、今のところ、下の様な表にする予定にしていますが、
 上の疑問への回答次第で、かなり変貌するかも知れません。

 <Sheet1> マクロ実行前 
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数 
   2    1  2018/7/3  なす    2018/7/4                                 
   3                 なす    2018/8/4                                 
   4                 なす    2018/9/10                                
   5                 なす    2022/7/3                                 

 <作業シート> マクロ実行後
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数 
   2    1  2018/7/3  なす    2018/7/4    要      新規               0 
   3                 なす    2018/8/4    不要    2018/7/3          32 
   4                 なす    2018/9/10   不要    2018/8/4          37 
   5                 なす    2022/7/3    要      2018/9/10       1392 

 ※ 作業シートは中間生成状態なので、後でSheet1(オリジナル)へ書き戻すような処置が
   必要になると思っていますが、まだその段階に至っておりません。

(半平太) 2018/08/05(日) 14:47


半平太さま

お返事ありがとうございます。

毎回手作業で、業務効率が下がって困っていました。

品質保証書は、「なす」なら「なす」において
最終出荷日から次の出荷日(まだ出荷していないので納品日)が2年以上あく場合に必要になる
それだけの条件です。

変更内容を、伝えるのは2022/7/3に依頼していた「なす」の保証書は
2022/6/3に「なす」の注文が入ったので7月分は6月に変更という連絡をします。

あとはステータス0があり、注文キャンセルです。
この場合は納品日はカウントしないです。☺

品質保証の内容に関しては担当業務外なので考慮の必要はなしです。

まだ出荷していない分の納品予定日は次の納品日から
前の納品日を引き算しようかと考えていました。

なので、半平太さまの前回出荷日が納品日に変わっているのは
大正解です‼凄い‼

実際のシート構成はもう少し情報欄が多いです。
注文番号や納品場所とか担当者、ロット番号などの欄もあります。
ですので、コードの横に参照セルなどの
範囲を変更できるような
目印コメントを残していただけないでしょうか。

簡単なコードは多少読めるのですが、
複雑なのは理解するのに時間がかかります。

(かなぶん) 2018/08/05(日) 16:02


補足です。

品質保証書類作成担当者へは

作成対象のものだけをソートして別bookにコピペして
データを渡しています。
対象行すべて抜き出してます。
必要な部分だけだと、コピペがずれてしまいそうだからです。
(かなぶん) 2018/08/05(日) 16:09


 >変更内容を、伝えるのは2022/7/3に依頼していた「なす」の保証書は 
 >2022/6/3に「なす」の注文が入ったので7月分は6月に変更という連絡をします。

 その7月分と言うのはどう認識するんですか?

 例えば、下記、実行前 → 実行後 になったとき、
 実行前の状態なんてどこにも残ってないですから、
 何がどう変わったのか分かんないですよ?

 <Sheet1> マクロ実行前
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数 
   2    1  2018/7/3  なす    2018/7/4    要      新規               0 
   3                 なす    2018/8/4    不要    2018/7/3          32 
   4                 なす    2018/9/10   不要    2018/8/4          37 
   5                 なす    2022/7/3    要      2018/9/10       1392 
   6                 なす    2022/6/3                                 

 <作業 シート> マクロ実行後
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数 
   2    1  2018/7/3  なす    2018/7/4    要      新規               0 
   3                 なす    2018/8/4    不要    2018/7/3          32 
   4                 なす    2018/9/10   不要    2018/8/4          37 
   5                 なす    2022/6/3    要      2018/9/10       1362 
   6                 なす    2022/7/3    不要    2022/6/3          30 

 何か工夫しないとならないです。
 かなぶんさんと発行担当者の人間関係にも影響が出ますので、軽く考えない方がいいと思います。

 例えばですが、H列以降に前の状態を表示するとか。
(それでも十分じゃないと思いますけど、自分の頭で考えてください。私は部外者なんで良く分かりません)

 例:<作業シート> マクロ実行後
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____ __H__ __I__
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数  前回  変更 
   2    1  2018/7/3  なす    2018/7/4    要      新規               0  要    無   
   3                 なす    2018/8/4    不要    2018/7/3          32  不要  無   
   4                 なす    2018/9/10   不要    2018/8/4          37  不要  無   
   5                 なす    2022/6/3    要      2018/9/10       1362        有   
   6                 なす    2022/7/3    不要    2022/6/3          30  要    有   

 >実際のシート構成はもう少し情報欄が多いです。 
 >注文番号や納品場所とか担当者、ロット番号などの欄もあります。 
 >ですので、コードの横に参照セルなどの範囲を変更できるような 
 >目印コメントを残していただけないでしょうか。 

 いや、今、実際の構成を示して頂く必要があります。

 後で「実際のレイアウトとは違うので動きません、どこを直せばいいですか?」とか
 言われても、単なる二度手間の話なので私は対応しません。

 コメントは、私が必要と思うものしか書きません。

 >品質保証書類作成担当者へは 
 >作成対象のものだけをソートして別bookにコピペして 
 >データを渡しています。 

 ・・と言う事は、担当者に前回との比較をさせているんですよね?
 私が担当者なら怒る・・けどなぁ、多分もの分かりのいい人なんですね。

(半平太) 2018/08/05(日) 17:34


半平太さま

いつもありがとうございます。

変更の違いは注文番号で認識しています。
同じ「なす」でも、s011とかd445など
なす1注文に対して注文番号か存在します。

前回との差は保証書要か不要か記しているところで判断していました。
関数で表示していたので、データが変わって、
経過日数が少なくなると要だったけど不要なんだ。
と、変更したと気がつきます。

経過日数は数式で変わりますが
要か、不要は手作業で表示していました。

別ブックで前回コピペしたデータを残しているので、
追加と変更を差分で表示させて確認して渡していました。
新たに作業列を作って前回を表示出来たら助かります‼
もしくは、変わった所だけ色をつけてもらえると助かります。
要と不要の場所に色がつくとか、ステータスのところに変更有りなど表示させるとか
(出来るのか難しいのかなど分からないで発言しています。スミマセン。)

シート構成は、明日提示させてください。
控えてきます。

(かなぶん) 2018/08/05(日) 18:01


 >要か、不要は手作業で表示していました。

 今後はマクロが「要否」を自動的に判断して入力します。手入力はしないでください。
 さもないと、後述の「変更の方向」が正しく表示できなくなります。

 なお、出荷日が入っているものは確定データなので「要否」を書換えることはしません。

 結局、H列の変更欄は「有」のみにして、変更が目立つようにし、
 I列は「変更の方向」を示すくらいでいいのかなと思います。

 例:<作業シート> 実行後
  行 __A__ ____B____ ___C___ _____D_____ ___E___ _____F_____ ____G____ __H__ ____I____
   1 状態  出荷日    商品名  納品予定日  保証書  前回出荷日  経過日数  変更  方向     
   2    1  2018/7/3  なす    2018/7/4    要      新規               0                 
   3                 なす    2018/8/4    不要    2018/7/3          32                 
   4                 なす    2018/9/10   不要    2018/8/4          37                 
   5                 なす    2022/6/3    要      2018/9/10       1362  有    無→ 要 
   6                 なす    2022/7/3    不要    2022/6/3          30  有    要→不要 

 今後は、正確なシート構成の説明があるまで、私は動きません。(二度手間は避けたい)

 最後に、作業シートの結果を「いつ、どういう状態」にしてオリジナルのシートに戻すか、ですね。
 (オリジナルシートに戻すと、「前回の要否」が完全に書き換わるので、元の情報に戻せません)

 作業シートが実際どんな出来上がりになるのか見てから、考えていただいた方が現実的かも知れません。

(半平太) 2018/08/05(日) 19:43


半平太さま

お世話になっております。
シート構成をご連絡いたします。
実は この台帳は3社分それぞれに項目が異なっております。

 ****(台帳-M)*****
 A〜APまであります。

 A	B	C	D	I	   J	      K	  P
 状態	備考	出荷日	入庫	品質保証書 注文番号  野菜名  納期

 経過日数→AQ
 変更→AR
 方向→AS

 にしたいと思います。

 ***(台帳K)****
 A〜Zまであります。

 A	B	C	E	G	I	K	L	W	X	Y
 状態	備考	ステータス	出荷日	注文番号	納期	品質保証書	野菜名	経過日数	変更	方向

 ***(台帳N)****
 A〜Wまであります。

 A	B	C	E	G	H	J	K	U	V	W
 状態	備考	ステータス	出荷日	納期	注文番号	品質保証書	野菜名	経過日数	変更	方向

で お願いできたらと思います。

:::::::::::::::::::::::::::::::::::::::::::::::::::::::::

発動のタイミングは
自分でマクロをボタン登録して押したら動くといいです。

前回出荷日がないときは 新規ではなく 前回なし と表示になるとうれしいです。

同じ商品が 同じ納品日で複数ある場合は(注文番号は異なります)
注文番号が若いものに 品質保証書をつけたいです。

よろしくお願いします。

(かなぶん) 2018/08/06(月) 17:59


 >実は この台帳は3社分それぞれに項目が異なっております。

 どれか1社を選んでください。3社やるつもりはありませんので。

 台帳Kは、項目名数は11、アルファベット数がY列までで11列、
 「A〜Z」まであるとすると「Z」は何なのか不明。

 台帳Mには「ステータス」が見当たりませんが、どうなっているんでしょうか?

 >半平太さま
 自分で言い出すのもなんですが、「さん」づけでお願いします。

(半平太) 2018/08/06(月) 19:54


半平太さん

失礼しました。
Mをお願いします。
Mが一番多いのでお願いします。

Mはお客様と仕上がりの予想図?というか、こんなふうになりますけど良いですか?という
確認の打ち合わせがありません。ですので、確認中とかgoとかいう項目が不要なんです。

Kの台帳のZは備考です。変更が多いので色々メモ書きを残してます。
(かなぶん) 2018/08/06(月) 20:30


 取りあえず、作業シートに結果を表示するまで。

 (この結果をどう「台帳-M」に戻すか、そのタイミングと戻し場所に付き、考察が必要)

 ’全て「台帳-M」のシートモジュールへ コピペ
 ’つまり、標準モジュールへ ではない(重要)

 Private Enum Colin '作業シートのC,D,E列の配列に対応
     出荷日 = 1
     野菜名
     納期
 End Enum

 Private Enum Colout '作業シートのF,(G),H,I,J,K列の配列に対応
     品質保証書 = 1
     前回出荷日 = 3
     経過日数
     変更
     方向
 End Enum

 Sub 台帳M処理()
     Const DTname As String = "台帳-M" ' ←実際のデータシート名に変更する
     Dim WsDT As Worksheet
     Dim WsWork As Worksheet
     Dim DTin, DTout, Status
     Dim RW As Long
     Dim PreModel, PreLastest
     Dim Def As Long
     Dim judgeDate

     Set WsDT = Sheets(DTname)
     Set WsWork = Sheets("作業")

     '作業シートに処理対象データ列をコピーする
     Application.ScreenUpdating = False
         Call CopyDataToWsWork(WsDT, WsWork)
     Application.ScreenUpdating = True

     WsWork.Columns("J:K").ClearContents
     WsWork.Range("H1:K1") = [{"前回出荷日","経過日数","変更","方向"}]

     With WsWork  '処理データの格納と出力データの入れ物を確保する
         DTin = .Range("C2", .Cells(.Rows.Count, "E").End(xlUp)).Value
         DTout = .Range("C2", .Cells(.Rows.Count, "E").End(xlUp)).Offset(, 3).Resize(, 6).Value
     End With

     PreModel = Empty '初期化
     PreLastest = Empty   '初期化

     For RW = 1 To UBound(DTin)

                 judgeDate = IIf(DTin(RW, 出荷日) = "", DTin(RW, 納期), DTin(RW, 出荷日))

                 If PreModel <> DTin(RW, 野菜名) Then '新規商品名である

                     If DTin(RW, 出荷日) = "" Then    '予定データのみ処理
                         If DTout(RW, 品質保証書) <> "要" Then
                             DTout(RW, 変更) = "有"
                             DTout(RW, 方向) = IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→ 要"
                             DTout(RW, 品質保証書) = "要"        '強制
                             DTout(RW, 前回出荷日) = "前回なし"
                             DTout(RW, 経過日数) = 0
                         End If
                     End If

                     PreModel = DTin(RW, 野菜名)  '次処理用に初期化

                 Else    '2回目以降に出現した商品の処理

                     If DTin(RW, 出荷日) = "" Then   '予定データのみ処理
                         Def = judgeDate - PreLastest

                         Select Case Def
                             Case Is < 730 '不要
                                 If DTout(RW, 品質保証書) <> "不要" Then
                                     If DTout(RW, 品質保証書) <> "" Then '前回何らかの入力がある時のみ
                                         DTout(RW, 変更) = "有"
                                         DTout(RW, 方向) = IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→不要"
                                     End If

                                     DTout(RW, 品質保証書) = "不要"        '強制

                                 End If

                             Case Is >= 730 '要
                                 If DTout(RW, 品質保証書) <> "要" Then
                                     DTout(RW, 変更) = "有"
                                     DTout(RW, 方向) = IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→ 要"

                                     DTout(RW, 品質保証書) = "要"        '強制

                                 End If
                         End Select

                         DTout(RW, 経過日数) = Def
                         DTout(RW, 前回出荷日) = PreLastest

                     End If
                 End If

                 PreLastest = judgeDate
     Next RW

     WsWork.Range("F2").Resize(UBound(DTout), 6) = DTout
 End Sub

 Private Sub CopyDataToWsWork(WsDT As Worksheet, WsWork As Worksheet)
     Dim clm, cnt As Long, Height As Long

     With WsWork.UsedRange
         Height = WsDT.UsedRange.Rows.Count
         .ClearContents
         cnt = 1

         For Each clm In [{1,3,11,16,9,10}] '操作対象の列をコピーする
             .Columns("A").Resize(Height, 1).Offset(, cnt).Value = WsDT.Columns(clm).Value
             cnt = cnt + 1
         Next

         With .Range("A2") '元のシートに戻す時に備え、元シートの行番号を振って置く
             .Value = 2
             .AutoFill Destination:=.Resize(Height, 1), Type:=xlFillSeries
             .Offset(-1).Value = "OrgRow"
         End With
     End With

    With WsWork.Sort.SortFields '野菜名>出荷日>納期>注文番号の順にソート
         .Clear
         .Add Key:=Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending
     End With

     With WsWork.Sort
         .SetRange Range("A:G")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
     End With

     WsWork.Select
     WsWork.Range("A1").Select
 End Sub

(半平太) 2018/08/06(月) 23:13


半平太さん

ありがとうございます。
あとでシートモジュールに貼り付けてみます。
\( ´∀`)/

少しだけコード分かりました。
コメントありがとうございます。

マクロはループ印刷程度しかわかりません。(初歩レベルです)
凄いなぁと思います。尊敬です。
(かなぶん) 2018/08/07(火) 04:39


半平太さん

試してみました!

作業シートを予め用意しないといけないのですね。
作業シートを作って作動させたらうまくいきました。

時間まであってビックリしました。

品質保証の要否は品質保証欄に表示してほしいです。

前回出荷日(納期)、経過日数、変更、方向が
AQから先に表示してほしいです。

作動の時期?は
マクロを実行したとき?でお願いします。
(かなぶん) 2018/08/07(火) 19:32


 >時間まであってビックリしました。 

 「時間」って、何でしょうか?
  ちょっとこちらでは分からないのですけど。

 >品質保証の要否は品質保証欄に表示してほしいです。
 作業シート上の話なら、そうなっていると思うんですが?
 そうじゃないのですか?

 >前回出荷日(納期)、経過日数、変更、方向が 
 >AQから先に表示してほしいです。 
 作業シートからオリジナルシートへ書き戻す時の話ですね?

 >作動の時期?は 
 >マクロを実行したときでお願いします。
 まずは、作業シート上に表示された結果が「問題なかったのか」知りたいです。
 ※実際のデータでやってみた結果で知りたいです。
  簡単なサンプルデータでの結果では心もとないです。
  
  オリジナルシートに書戻したら前回の状態は無くなるので
  (当然、もう一回同じことをしてみるって訳にいかなくなるので)
  書戻しは慎重に進めないとならないです。

 因みに、この作業はどのくらいの頻度でやるんですか?(1日一回?)

(半平太) 2018/08/07(火) 19:59


半平太さん

私が時間だと思ったのは違うのかもしれないです。
0が沢山あったので、時間かと思ってしまいました。

実際のデータで試しました。
動いたことが嬉しくて嬉しくて。

今日はトラブルがあり、ゆっくり検証できませんでした。
明日再度確認します。申し訳有りません。

品質保証欄に表示してほしいのは
台帳に戻すときです。

方向、変更、前回出荷日も台帳へ戻すときのことです。

注文データを台帳へのせるのは週2日位ですが
出荷はほぼ毎日です。
出荷日を入れると作動させたいです。

(かなぶん) 2018/08/07(火) 20:30


 >出荷日を入れると作動させたいです。 
 本当にそんなに頻繁にやっていいんですかねぇ。

 発行担当者が嫌がる様な気がするんですけど・・
 まぁ、他所の会社のことなのでこれ以上首を突っ込むのは止めますけど。

 以下、3社対応版を作りました。

 テストは、必ずバックアップを取って実施してください。
 ※ 書戻しがあるので、元の状態には戻れません。留意してください。

 1.以前のプログラム(シートモジュールに書いたもの)は全て消去してください。

 2.今回は、後記マクロを「標準モジュール」にコピペしてください。

 3.想定シート名
  (1)作業
  (2)台帳-M ’これだけハイフン"-" あり。(本当? そちらで書いて来たまんまです)
  (3)台帳K
  (4)台帳N

 4.実行方法
  それぞれ目的に応じて、以下のプログラムの一つを実行する。
   Sub 台帳M処理()
   Sub 台帳K処理()
   Sub 台帳N処理()

 5.標準モジュールに貼り付けるマクロ

 Private Enum Colin '作業シートのC,D,E列の配列に対応
     出荷日 = 1
     野菜名
     納期
 End Enum

 Private Enum Colout '作業シートのF,(G),H,I,J,K列の配列に対応
     品質保証書 = 1
     前回出荷日 = 3
     経過日数
     変更
     方向
 End Enum

 Const NameM As String = "台帳-M"  ' ←実際のデータシート名に変更する
 Const NameK As String = "台帳K"   ' ←実際のデータシート名に変更する
 Const NameN As String = "台帳N"   ' ←実際のデータシート名に変更する
 Const NameW As String = "作業"

 Sub 台帳M処理()
     Dim WsM As Worksheet, WsWork As Worksheet

     Set WsWork = Worksheets(NameW)
     Set WsM = Worksheets(NameM)

     Application.ScreenUpdating = False
         Call GeneProc(WsM, [{1,3,11,16,9,10}], WsWork) 'ステータス欄無縁
         Call SortBackToOriginal(WsWork) '作業シートをオリジナルの順に並べ戻す

         Rem オリジナルへ書き戻す
         Call placeBackResult(WsM, [{9,43,44,45,46}], WsWork, [{6,8,9,10,11}])
     Application.ScreenUpdating = True
 End Sub

 Sub 台帳K処理()
     Dim WsK As Worksheet, WsWork As Worksheet

     Set WsWork = Worksheets(NameW)
     Set WsK = Worksheets(NameK)

     Application.ScreenUpdating = False
         Call GeneProc(WsK, [{3,5,12,9,11,7}], WsWork)  'ステータス欄含む
         Call SortBackToOriginal(WsWork) '作業シートをオリジナルの順に並べ戻す

         Rem オリジナルへ書き戻す
         Call placeBackResult(WsK, [{11,23,24,25,26}], WsWork, [{6,8,9,10,11}])
     Application.ScreenUpdating = True
 End Sub

 Sub 台帳N処理()
     Dim WsN As Worksheet, WsWork As Worksheet

     Set WsWork = Worksheets(NameW)
     Set WsN = Worksheets(NameN)

     Application.ScreenUpdating = False
         Call GeneProc(WsN, [{3,5,11,7,10,8}], WsWork)  'ステータス欄含む
         Call SortBackToOriginal(WsWork) '作業シートをオリジナルの順に並べ戻す

         Rem オリジナルへ書き戻す
         Call placeBackResult(WsN, [{10,21,22,23,24}], WsWork, [{6,8,9,10,11}])
     Application.ScreenUpdating = True
 End Sub

 Sub GeneProc(WsSrc As Worksheet, SrcOrder, WsWork As Worksheet)
     Dim DTin, DTout, Status
     Dim RW As Long
     Dim PreModel, PreLastest
     Dim Def As Long
     Dim judgeDate
     Dim doNormalProc As Boolean

     '作業シートに処理対象シートの列データをコピーする
     Call CopyDataToWsWork(WsSrc, WsWork, SrcOrder)

     WsWork.Columns("J:K").ClearContents
     WsWork.Range("H1:K1") = [{"前回出荷日(納期)","経過日数","変更","方向"}]

     With WsWork  '処理データの格納と出力データの入れ物を確保する
         DTin = .Range("C2", .Cells(.Rows.Count, "E").End(xlUp)).Value
         DTout = .Range("C2", .Cells(.Rows.Count, "E").End(xlUp)).Offset(, 3).Resize(, 6).Value

         '台帳-Mでは利用しないが、B列を一律に格納
         Status = .Range("B2", .Cells(.Rows.Count, "E").End(xlUp).Offset(, -3)).Value
     End With

     PreModel = Empty '初期化
     PreLastest = Empty   '初期化

     For RW = 1 To UBound(DTin)
         doNormalProc = True

         If WsSrc.Name = NameK Or WsSrc.Name = NameN Then 'ステータスを考慮する必要がある台帳である

             'もしステータス欄が0ならキャンセルなので、以前が「要」なら「不要」に変える。
             If Status(RW, 1) & "" = "0" Then
                 If DTout(RW, 品質保証書) = "要" Then
                     DTout(RW, 変更) = "有"
                     DTout(RW, 方向) = "要→不要"
                 End If
                 doNormalProc = False  'この行のデータはこの処理だけとする
             End If
         End If

         If doNormalProc Then 'キャンセルとは無縁のデータとして処理続行

             judgeDate = IIf(DTin(RW, 出荷日) = "", DTin(RW, 納期), DTin(RW, 出荷日))

             If PreModel <> DTin(RW, 野菜名) Then '新規商品名である

                 If DTin(RW, 出荷日) <> "" Then '出荷済みの場合
                      If DTout(RW, 前回出荷日) = "" Then  '前回データが無い場合のみ追記
                         DTout(RW, 前回出荷日) = "前回なし"
                      End If
                 Else '未出荷の場合
                     DTout(RW, 前回出荷日) = "前回なし"

                     If DTout(RW, 品質保証書) <> "要" Then
                         DTout(RW, 変更) = "有"
                         DTout(RW, 方向) = IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→要"
                         DTout(RW, 品質保証書) = "要"        '強制
                         DTout(RW, 経過日数) = 0
                     End If
                 End If

                 PreModel = DTin(RW, 野菜名)  '次処理用に初期化

             Else    '2回目以降に出現した商品の処理

                 If DTin(RW, 出荷日) = "" Then    '予定データのみ処理
                     Def = judgeDate - PreLastest

                     Select Case Def
                         Case Is < 730 '不要
                             If DTout(RW, 品質保証書) <> "不要" Then
                                 If DTout(RW, 品質保証書) <> "" Then '前回何らかの入力がある時のみ
                                     DTout(RW, 変更) = "有"
                                     DTout(RW, 方向) = _
                                         IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→不要"
                                 End If

                                 DTout(RW, 品質保証書) = "不要"        '強制

                             End If

                         Case Is >= 730 '要
                             If DTout(RW, 品質保証書) <> "要" Then
                                 DTout(RW, 変更) = "有"
                                 DTout(RW, 方向) = _
                                     IIf(DTout(RW, 品質保証書) = "", "無", DTout(RW, 品質保証書)) & "→要"

                                 DTout(RW, 品質保証書) = "要"        '強制

                             End If
                     End Select

                     DTout(RW, 経過日数) = Def
                     DTout(RW, 前回出荷日) = PreLastest
                 End If
             End If

             PreLastest = judgeDate
         End If
     Next RW

     WsWork.Range("F2").Resize(UBound(DTout), 6) = DTout
 End Sub

 Rem データシートから処理対象の列を作業シートへコピーする
 Sub CopyDataToWsWork(WsSrc As Worksheet, WsWork As Worksheet, Order)
     Dim clm, cnt As Long, Height As Long

     With WsWork.UsedRange
         Height = WsSrc.UsedRange.Rows.Count
         .ClearContents
         cnt = 1

         For Each clm In Order '操作対象の列をコピーする
             .Columns("A").Resize(Height, 1).Offset(, cnt).Value = _
             WsSrc.Columns(clm).Resize(Height, 1).Value
             cnt = cnt + 1
         Next

         With .Range("A2") '元のシートに戻す時に備え、元シートの行番号を振って置く
             .Value = 2
             .AutoFill Destination:=.Resize(Height, 1), Type:=xlFillSeries
             .Offset(-1).Value = "OrgRow"
         End With
     End With

     With WsWork.Sort.SortFields '野菜名>出荷日>納期>注文番号の順にソート
         .Clear
         .Add Key:=Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending
     End With

     With WsWork.Sort
         .SetRange Range("A:G")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
     End With

     WsWork.Select
     WsWork.Range("A1").Select
 End Sub

 Rem 作業シートをオリジナル順に並べ替え
 Sub SortBackToOriginal(WsWork As Worksheet)
     With WsWork.Sort.SortFields 'オリジナル順に並べ戻す
         .Clear
         .Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending
     End With

     With WsWork.Sort
         .SetRange Range("A:K")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
     End With
 End Sub

 Rem 作業シートの結果をオリジナルシートに書き戻す
 Sub placeBackResult(WsSrc As Worksheet, OrderToBack, WsWork As Worksheet, OrderOfWork)
     '作業{"品質保証書","前回出荷日(納期)","経過日数","変更","方向"}
     '作業{6,8,9,10,11}
     '    ↓
     'M {9,43,44,45,46}
     'K {11,23,24,25,26}
     'N {10,21,22,23,24}

     Dim clmSrc, clmWork, cnt As Long, Height As Long

         Height = WsSrc.UsedRange.Rows.Count
         cnt = 1

         For Each clmSrc In OrderToBack 'オリジナルシートに書戻す Mなら {9,43,44,45,46}
             clmWork = Application.Index(OrderOfWork, cnt) '作業シートの転記すべき列番を取得

             WsSrc.Columns(clmSrc).Resize(Height, 1).Value = _
                 WsWork.Columns(clmWork).Resize(Height, 1).Value

             cnt = cnt + 1
         Next
     WsSrc.Select
     WsSrc.Range("A1").Select
 End Sub

(半平太) 2018/08/08(水) 17:00


半平田さん!!!

ありがとうございます。
他のも対応してくださるなんて(感激です。)

今日、再度試してみました。
やはり、上2つのセルだけ時間表示になってました。
えーっと、作業シートの左のやつです。

それから、型があいませんと表示されました。

今日は天候の都合で、会社が途中で休業になり
十分に検証できませんでした。

明後日から夏休みで、自宅にはパソコンがないので
なんとしても明日、どこで表示が出たかお伝えしたいと思います。

頻度は、よく考えてみたら注文データが増えたときだけ作動すれば良いのですよね。
週1〜2回位で👌okですね。

台帳の名前ですが、なんで−入れたのか自分でもわかりません。

携帯から入力しているので、へんなところ触ってしまったのかもです。

私も、もっとパソコン使えるようになりたいので
頑張ります!

それと、
半平田さんは、なんとお読みすれば良いのですか?
はんぺいたさん?はんひらたさんでしょうか?

ありがとうございます。
(かなぶん) 2018/08/08(水) 19:09


 >やはり、上2つのセルだけ時間表示になってました。 
 セルの書式のセイでそうなっているんじゃないですか?
 書式を標準に変更してみてください。

 >それから、型があいませんと表示されました。
 プログラムが止まって、黄色くハイライトされている部分があると思いますので、
 どのステートメントなのか、そしてそこにある変数名にマウスを近づけると、
 どんな値になっているのか分かりますので、それが何なのかメモして、教えてください。

 >頻度は、よく考えてみたら注文データが増えたときだけ作動すれば良いのですよね。 
 >週1〜2回位でokですね。 
 リーズナブルかもです。
 影響を受ける人の身に置き換えて対処すると人間関係が旨く行くかも知れません。

 >台帳の名前ですが、なんで−入れたのか自分でもわかりません。 
 >携帯から入力しているので、へんなところ触ってしまったのかもです。 
 とにかく、実際のシート名をここに入れてください。
               ↓
  Const NameM As String = "台帳-M"  ' ←実際のデータシート名に変更する
  Const NameK As String = "台帳K"   ' ←実際のデータシート名に変更する
  Const NameN As String = "台帳N"   ' ←実際のデータシート名に変更する

 >半平田さんは、なんとお読みすれば良いのですか?

  半平太なんですけどー
  洋平太と言われないだけマシですが。。時々間違えられます (-_-;)

  はんぺいたです。幕末に 武市半平太 って人が居ました。

(半平太) 2018/08/08(水) 20:02


半平太さん

素敵なお名前 間違えてしまって 申し訳ありませんでした。

さて、台帳Mの件ですが

  Private Sub CopyDataToWsWork(WsDT As Worksheet, WsWork As Worksheet)
     Dim clm, cnt As Long, Height As Long

     With WsWork.UsedRange
         Height = WsDT.UsedRange.Rows.Count
         .ClearContents
         cnt = 1

         For Each clm In [{1,3,11,16,9,10}] '操作対象の列をコピーする
             .Columns("A").Resize(Height, 1).Offset(, cnt).Value = WsDT.Columns(clm).Value
             cnt = cnt + 1
         Next

         With .Range("A2") '元のシートに戻す時に備え、元シートの行番号を振って置く
             .Value = 2
             .AutoFill Destination:=.Resize(Height, 1), Type:=xlFillSeries
             .Offset(-1).Value = "OrgRow"
         End With
     End With

    With WsWork.Sort.SortFields '部品番号>出荷日>納期>注文番号の順にソート
         .Clear
         .Add Key:=Range("D2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending
     End With

     With WsWork.Sort
         .SetRange Range("A:G")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
     End With

     WsWork.Select   '←ここで 出荷日の上2段が時間に代わってしまいました。
     WsWork.Range("A1").Select
 End Sub

それまでは 普通に日付表示でした。セルも標準でしたが
途中からユーザー定義に代わってしまいました。

そして

   judgeDate = IIf(DTin(RW, 出荷日) = "", DTin(RW, 納期), DTin(RW, 出荷日))

この場所で止まってしまいました。

台帳を確認したら、すでに納品した過去のデータに納期に日にちがありませんでした。
だから 納期にEMPTYが見えたのかなと思いました。

こんなご報告で よいでしょうか???

(かなぶん) 2018/08/09(木) 11:07


 済みませんが、テストは「3社対応版」でやってください。

 > WsWork.Select   '←ここで 出荷日の上2段が時間に代わってしまいました。
 そこで書式が変わる事はありません。
 セルの書式については何も手をつけていないので、こちらでは分かりません。

 > judgeDate = IIf(DTin(RW, 出荷日) = "", DTin(RW, 納期), DTin(RW, 出荷日))
           ↑ ↑         ↑       ↑
           これらの4つの矢印の先にマウスを近づけると、どんな値が表示されるか教えてください。

 >すでに納品した過去のデータに納期に日にちがありませんでした。 
 >だから 納期にEMPTYが見えたのかな
 関係ないと思いますが、こちらでエラーが再現できないことには、なんとも言えません。

(半平太) 2018/08/09(木) 14:43


半平太さん

勘違いして最初のコードで試してしまいました。
すみません。

DTINに日付が見えました。
fと゛゛のところは見ませんでした。

16日にまた確認します。
日にちが空いてしまいます。
申し訳有りません

(かなぶん) 2018/08/09(木) 18:17


 >fと゛゛のところは見ませんでした。

 ちょっと意味が分かりません。
 以下の3つがどうなっているのか知りたいのですが?

 RW
 DTin(RW, 出荷日)
 DTin(RW, 納期)

 DTin(RW,XX)が全部日付なら「型違いのエラー」になるとも思えないのですが?

(半平太) 2018/08/09(木) 19:12


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.