[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『伝票作成とピッキングリスト』（にょろ）
の続きです。
ピッキングリストの伝票枚数がまだ元の枚数（ピッキングできなかった伝票含めた枚数）のままです…
あと２点追加とこちらの補足不足がありました。
１．在庫表の出荷履歴の書式ですが、現在「出荷数」が入ったセルの罫線だけが前の列のものをコピーされていますが、 列全体の書式（セルの色含む）をコピーすることはできますか？
２．ピッキングリストの名前が「原紙 ピッキング」のままなので、伝票作成時と同様に「日付+区分+便名」 （同じシート名があったら(2)とつける感じで）にできますでしょうか？
>ピッキングリストの伝票枚数がまだ元の枚数（ピッキングできなかった伝票含めた枚数）のままです…
対応忘れ。
fnPicLst の
.Range("H5").Value = WorksheetFunction.Sum(shW.Columns("K"))
これを
.Range("H5").Value = WorksheetFunction.SumIf(shW.Columns("F"), "○", shW.Columns("K"))
>列全体の書式（セルの色含む）をコピー
fnAllocDtl の
shZ.Cells(w(0), FinalInv).Offset(, 1).Copy
shZ.Cells(w(0), colZ).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
これを
shZ.Columns(FinalInv).Offset(, 1).Copy
shZ.Columns(colZ).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
>ピッキングリストの名前が「原紙 ピッキング」のままなので、伝票作成時と同様に「日付+区分+便名」
fnPickLst の
Set picSh = ActiveSheet
この下に
picSh.Name = Format(Date, "yyyymmdd") & DlvType & DlvCycle
あわせて、伝票関連処理の
Call 商品IO(fnPickLst, DataId, DlvCycle)
これを
Call 商品IO(fnPickLst, DataId, DlvCycle, DlvType)
(ぶらっと)
ぶらっと様ありがとうございます！
伝票枚数、書式、シート名うまくいきました。
前トピでお話をされていた「×だった商品の再引当て」の件を確認しました。 すると、当初の話と違う回答が来て私もちょっと困惑しているのですが…
・毎日14時に入庫処理を締める。その時に在庫不足だったものは欠品扱い ・欠品商品は、別途欠品リストを作成し、翌日以降の入庫を締めた時に引当てできるものは引当てをして消し込み
という流れになっているそうです。
なので、「欠品リスト」（伝票作成時に×になったもの）をリストアップし、翌日14時以降にそれを再度引当て可能かどうかチェック という形になります。
データシートのどこかに「欠品」のフラグを立て、「欠品リスト作成」→「再ピッキング」というのは難しいですか？ 伝票シートにフラグを立ててもいいですが、ブックが分かれるので大変ですよね…
本当にすみません…
（にょろ）
抽出した作業シートが、翌日の再処理時にも、そのままの内容で残っているということを前提にすると （つまり、○×が、そのまま残っている）IO商品に、ほんのちょっとだけパラメータを追加して、 『×』のものだけ再引当するという、そういうロジックが考えられるね。
もし、それでよければ、やってみるけど、いかが？
追記）翌日（次回）の抽出処理を行い作業シートを作成する際に、前回の作業シートの『×』データを繰り越して、 今回の作業シートに加えた上で一緒に引当処理を行うことも考えられるね。 ロジックとしては、このほうが簡単かもしれない。 この場合、伝票自体は、×でも作成済みなので、繰越データは伝票作成対象外にするという ロジックを加えることになる。
(ぶらっと)
よ～く考え直してみると、作業シートは、あくまで、処理上の作業用のテンポラリーシートだねぇ。 別バッチで異なる出荷作業をするわけで、そうすると作業シートも置き換わるね。
とすると、抽出->AllocTot の結果を、オリジナルのデータシートの可否欄に書き戻した方がいいのかもしれないね。 で、AllocTotでは今回抽出された作業シート（可否欄空白）とデータシートの×を対象に総量引当を行い、ここでＯＫになったものは データシート側にも○を書き戻した上で、AllocDtl->PicLst の対象にするということがいいのかな？
(ぶらっと)
ぶらっと様
＞AllocTotでは今回抽出された作業シート（可否欄空白）とデータシートの×を対象に総量引当を行い、ここでＯＫになったものは ＞データシート側にも○を書き戻した上で、AllocDtl->PicLst の対象にするということがいいのかな？ はい、それでお願いします。
（にょろ）
引当不能のものの再引当、回答が遅れていてごめん。
処理自体はどうってことはないんだけど、それを、そちらの実際の運用の流れを想像しながら 無理のない運用で対応するには？というところで、あれこれ悩んでいて。
でも、これは、悩んでいてもしょうがないので、えいやっという割り切りで、自分流の方策を「もう少ししたら」 アップするので、しばらく待っていてね。
「前触れ」で。
・"引当繰越" というシートを用意して、そこに総量引当（fnAllocTot)の結果、× になったものを格納。 ・このレイアウトは、基本的には、入力シートや作業シートと同じ。 （作業シートと同様、自動的に作り出すので最初は空白シートでＯＫ） ・ただし、そのあとの処理で、区分、種別、便、日付といった情報が必要になりそうなので、そういった情報の列を 追加することになると思う。（これもマクロでやるので気にしないで） ・この × のみの引当繰越シートをトリガーにして、まず、総量引当、次にそこで○になったものを対象にした 明細引当（anAllocDtl)やピッキングリスト（fnPickLst)を動かすプロシジャを用意。これを実行して再引当を行う。 ・実際の、そちらのコードとしては、従来の伝票関連処理とは別々に起動してもいいし、続けて起動してもいい。 ・再引当の結果、○になったものは繰越シートから削除。
こんなことを考えている。
(ぶらっと)
ぶらっと様
ありがとうございます。 その内容で大丈夫です。 よろしくお願いいたします。
（にょろ）
ふぅ～、なんとか書いてみた。 作成済みの機能をそのまま活かすために、逆に四苦八苦？ 最初から、ここをスコープに入れておけばもう少し違う構成にもできたかと思うけど。
１．まず、引当繰越シートは必要な時にマクロ内で生成（引当繰越_yyyymmddhhnnss)する。 ２．通常の（今までの）処理の最後に作業シートで×がついたものをピックアップして引当繰越シートを生成。 ３．単独で動く "追加引当関連処理" を新設。 １）ブック内の引当繰越_yyymmddhhnnssシート毎に、そのイメージを作業シートにコピペして ２）総量引当、個別引当、ピッキングリストの処理をして ３）処理済みのシートを削除したうえで、今回も×だったものがあれば、引当繰越_yyyymmddhhnnssシートを再作成
こんな感じ。
★バグがたくさん出そうな予感あり。ピッキングリストも、今は新規ブックのままだけど、しかるべき名前で保存が 要望されるかもしれないし、追加引当（複数）をやったものと今日のピッキングリストを、同じブックにまとめたい こんな要望も出るかもしれないけど、いずれにしても、バグつぶしが終わってからにしようね。
●伝票関連処理に１行追加
Sub 伝票関連処理(DataId As String, OutDate As String, DlvCycle As String, DlvType As String)
Dim rtn As Long
Call 抽出(DataId, OutDate, DlvCycle, DlvType)
If Not 商品IO(fnInitial) Then Exit Sub
Call 商品IO(fnAllocTot, DataId)
Call 伝票作成(DataId)
Call 商品IO(fnAllocDtl, DataId, DlvCycle, DlvType)
Call 商品IO(fnPickLst, DataId, DlvCycle, DlvType)
Call 抽出繰越(DataId, OutDate, DlvCycle, DlvType) '追加
Call 商品IO(fnEnd)
End Sub
●実行処理として "追加引当関連処理"、サブプロシジャとして "抽出繰越" を新設。
Sub 追加引当関連処理()
Dim sh As Worksheet
Dim shW As Worksheet
Dim z As Long
Dim i As Long
Dim DataId As String
Dim OutDate As String
Dim DlvCycle As String
Dim DlvType As String
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "引当繰越_*" Then
sh.Cells.Copy ThisWorkbook.Sheets("作業").Range("A1")
If 商品IO(fnInitial) Then
DataId = sh.Range("Q1").Value
OutDate = sh.Range("Q2").Value
DlvCycle = sh.Range("Q3").Value
DlvType = sh.Range("Q4").Value
Call 商品IO(fnAllocTot, DataId)
Call 商品IO(fnAllocDtl, DataId, DlvCycle, DlvType)
Call 商品IO(fnPickLst, DataId, DlvCycle, DlvType)
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Call 抽出繰越(DataId, OutDate, DlvCycle, DlvType)
Call 商品IO(fnEnd)
End If
End If
Next
End Sub
Sub 抽出繰越(DataId As String, OutDate As String, DlvCycle As String, DlvType As String)
'作業シートの総量引当Ｘのものを引当繰越_xxxxx シートをコピー（自動生成）
Dim nSh As Worksheet
Application.ScreenUpdating = False
ThisWorkbook.Activate
With Worksheets("作業")
If WorksheetFunction.CountIf(.Columns("F"), "×") > 0 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set nSh = ActiveSheet
.Range("Q1").Value = .Range("F1").Value '可否欄タイトル
.Range("Q2").Value = "×" '抽出条件
.Columns("A:O").AdvancedFilter xlFilterCopy, .Range("Q1").CurrentRegion, nSh.Range("A1")
.Range("Q1").CurrentRegion.Clear
With nSh
'オリジナル抽出条件保存
.Range("Q1").Value = DataId
.Range("Q2").Value = OutDate
.Range("Q3").Value = DlvCycle
.Range("Q4").Value = DlvType
.Name = getSheetName(ThisWorkbook, "引当繰越_" & Format(Now(), "yyyymmddhhnnss"))
End With
End If
End With
Application.ScreenUpdating = True
End Sub
(ぶらっと)
ぶらっと様ありがとうございます。
テストしました。 一つ気づいた不具合（？）なんですが、伝票ブックを閉じないまま伝票作成→ピッキングリスト作成をしてしまうと 「伝票ブックを閉じてください」 というメッセージが出て伝票は作成されませんが、ピッキングリストは作成されます。 なので、もしこの処理をしてしまうと、「伝票がないのにピッキングリストだけ存在する」ということになってしまいます。 上記のメッセージの段階でピッキングリスト作成を中止するか、もしくは伝票ブックを開いたままでも処理できるか のどちらかで対応できますでしょうか？
あとご指摘のようにピッキングリストが別ブックで次々に増えていくのはやはり運用的には混乱の元かと… できればブック名を伝票ブックのように自動で作成し、同じ日付のものに追加していく方がいいです。
それとこれは実際やってみて思ったのですが、伝票ブックですが、現在C3セルに伝票作成日時が入ります。 これは元からの仕様なのでいいのですが、例えば最初に在庫不足で引当てができず、翌日の入荷で引当てをした場合に 「これはいつ入力した伝票なのか？」 というのがシート名とヘッダーでしか判別ができないので、どこかに「元の伝票の日付」を入れたいと思います。 現在C6セルに「伝票集計表」という見出しが入っているのですが、ここを 「元の伝票入力日+種別+"伝票集計表"」 のようにできますでしょうか。 例「12/7/4 単品 伝票集計表」…このようなイメージ
あ、あと ＞②こちらの認識不足だったんですが、在庫表の「出荷履歴」の一番上の行（S列であればS1セル）にその列の ＞合計数が入るようになっていたようです この部分ですが、現在合計が出ません。 最終在庫列か何かにあらかじめSUM関数を入れておいた方がよいですか？
色々とすみません…
（にょろ）
>「伝票ブックを閉じてください」 というメッセージが出て伝票は作成されませんが、ピッキングリストは作成されます
なるほど。そうだね。最初は、個々の機能ごとに逐次実行するイメージでコードを書いていて、途中から それを一連の処理としてつなげたのでこんな現象になってしまうね。 それもふくめて指摘をもらったことは、これから調査するけど、
>できればブック名を伝票ブックのように自動で作成し、同じ日付のものに追加していく方がいいです
先にコメントしたように、これは、ほかがすべてうまく動いてからにしよう。 ここでいう同じ日付とは、今日なら今日でいいんだよね。たとえば昨日の引当漏れを今日再引当したものの日付は 今日でいいよね。 本来なら昨日のピッキングリストに入っているべきなので今日のピッキングリストではなく、昨日のピッキングリストに 追加したいということだとちょっとやっかいな予感。
実際にはないのだろうけど、１０年前の繰越が、何度やってもきえず繰り越されている場合、それが引きあたれば １０年前のブックに挿入？
正直、それはやりたくない。どうしてもといわれてもさじを投げるかも。 （まぁ、それはそのときにまた悩もう。まずはバグつぶし）
(ぶらっと)
コードはそのうちにまとめて。 以下、追加確認おねがい。
>伝票ブック・・・・どこかに「元の伝票の日付」
まず、重要なポイントなんだけど、現在のコードは、伝票ブックには、可否が○であろうと×であろうと データを表示してるよ。だから、今回アップした追加引当のところでは伝票は作成していない。
これは、とくにそちらに確認はしていないんだけど、伝票レイアウトに 可否欄があるので、○は○、×は×で 表示している。
逆に、○のものだけで伝票を作成したいということ？
それと、ここでいう日付は、処理した日付だね。で、仮に、追加引当からも伝票を作成するとして、それは 最初に作成した伝票の日付ということだね？
もし、○だけで伝票をつくるということにして、最初の日には全量×で伝票が作られなかったとする。 ２～３日して引きあたった。 この時、実際には伝票は、２～３日後にはじめてつくられるわけだけど、このような場合の元伝票の日付って どの日付？
>②在庫表の「出荷履歴」の一番上の行（S列であればS1セル）にその列の合計数が・・・・
あぁ、そんな会話をしたのを思い出した。コードは未対応。 どうしようかな。出荷履歴書き込み時に計算式をセットするのはたやすいんだけど、ものが【在庫表】だよね。 当然、新しい商品の追加も（後日）あって、行数が増えていくかも。履歴更新時の2行目から、その時の在庫表の最終行 ないしは、その時の、当該出荷履歴列の一番したの行までのSUMでいい？ この部分ですが、現在合計が出ません。
(ぶらっと)
半分以上【グチ】で。
以前コメントしたと思うけど、出荷引当、ピッキングリストといった業務をシステムで対応するなら 本来は、しっかりしたＷＭＳを導入すべき。それだけ、運用制御とシステム制御の絡みが複雑。
もちろん、ＶＢＡという世界で対応するのがだめということじゃないし、だから取り組んでいるんだけど 最低２つのことが必要だね。
１．エクセルの世界ということを、逆に、しっかり利用。何を言いたいかというと、ブックを作ってしまってから 途中で処理がおわった。作ったブックは作られっぱなし！！
それでいいんだよ。エクセルは。そのような場合は、そのブックを削除すればいいんだから。
２．それと（今回は、特にこれが重要）
運用ルール・手順を、まず現場としっかり確定させる。ルールと書いたけど、ほんとにそうなんだよ。 ここをしっかり確定させておかないと、あぁ、こんな場合はだめだとか、あんな場合は困るとか。 で、それを現場の人にも納得・理解してもらった上で、それをシナリオとして確定する。 次に、それを実現するためにデータはどう持とうかとか、これは別ブックにしようとか。
そういうことを、きっちり決めてから、たとえば、この種の掲示板に質問ださないと、ただでさえ １．でのべたように、この世界のシステムはややこしいんだから。
まぁ、グチです。最後まで、さじを投げずに頑張る気持ちではいるので。
(ぶらっと)
＞ここでいう同じ日付とは、今日なら今日でいいんだよね。たとえば昨日の引当漏れを今日再引当したものの日付は ＞今日でいいよね はい、リストを作成した日でいいです。
＞逆に、○のものだけで伝票を作成したいということ？ すみません、説明の仕方が悪かったです。 伝票には可否○×どちらのものも記載します。 例をあげると
１．7/3に単品・1便のデータを入力。伝票を作成すると下記のようになった
A001 羽毛布団 5個 ○ （引当て後在庫5個） A002 敷布団 7個 × （現在庫3個） A003 羽根枕 8個 × （現在庫0個）
→この時は「A001 羽毛布団 5個」のピッキングリストを作成。他は繰越リストに記載
２．7/4に「A002 敷布団」が10個入荷があった 更に当日に単品・1便で注文があった下記のデータを入力した
A002 敷布団 15個 A004 シーツ青 5個
３．入庫締め後、7/3単品・1便の繰越分の伝票を再作成
A002 敷布団 7個 ○ A003 羽根枕 8個 ×
→「A002 敷布団」のピッキングリストを作成、「A003 羽根枕」は繰越リストに記載
４．続いて7/4の単品・1便の伝票を作成
A002 敷布団 15個 × A004 シーツ青 5個 ○
→「A004 シーツ青」のピッキングリストを作成、「A002 敷布団」は繰越リストに記載
上記の流れで7/3繰越分と7/4当日分の伝票を作成するわけですが、伝票ブック（シート）の画面で 「どちらが繰越分の伝票でどちらが当日の伝票か」 というのが分かりにくいかな、と思ったんです。
なので、これまで通り引当ての可否にかかわらず伝票は作成するのですが、その元のデータが入力されたのが いつなのかを表示させた方がいいと思いまして…
なので
12/7/3 単品 伝票集計表
A002 敷布団 7個 ○ A003 羽根枕 8個 ×
12/7/4 単品 伝票集計表
A002 敷布団 15個 × A004 シーツ青 5個 ○
このように表示したいと思ったのですが… 説明が下手ですみません
＞履歴更新時の2行目から、その時の在庫表の最終行 ＞ないしは、その時の、当該出荷履歴列の一番したの行までのSUMでいい？ はい、それで大丈夫です
すみません、また衝突しました
おっしゃる通りです… ちゃんと現場と話し合って、業務を把握してからにすべきでした。反省しています…
（にょろ）
まず、アップしたコードにバグ発見。 最初に×になったものを再引当、ここまではいいんだけど、これでまた×になった時、キーとなる情報の一部が消えてしまう。 とりあえず、テストは再引当までにしておいてね。
それと、伝票とピッキングリストについて、現在のコードでやっていることを、もう一度説明するね。
・まず、伝票は、最初の伝票関連処理で○も×も作成。再引当では『作成しない』 ・ピッキングリストは最初の伝票関連処理でも、それ以降の再引当でも、○のもののみ作成。
これを踏まえて、それどＯＫとか、いやいや、こういうように作成したいと説明してくれるかな？
(ぶらっと)
一応、伝票（？）に、オリジナルの情報を記載するところ以外は対応した。 テストは、あまり入念にはやっていないのでバグのてんこ盛りかな？
１．ピッキングリスト
ブック名を PickingList20120706通常3便.xlsx といった形にしてマクロブックと同じフォルダに保存。
そこに追加していく。最初は新規に作成し、次からはエクセル上に開かれていれば、そこに追加。
エクセル上になければ、フォルダから読み込んで追加。
２．出荷履歴の1行目に式をセット。
３．伝票ブックが閉じられていない場合、メッセージ後、処理を終了。
４．こちらで発見した、再引当の再引当時のバグつぶし
かなり直しているのでバージョンの食い違いがちょっと怖いね。必要ならコードフルセットアップするけど とりあえず、以下。 結構、トピが大きくなったので、これ以降のバグつぶしは新しいトピをたててくれたほうがいいかな？
●伝票関連処理リバイス
Sub 伝票関連処理(DataId As String, OutDate As String, DlvCycle As String, DlvType As String)
Dim rtn As Long
Call 抽出(DataId, OutDate, DlvCycle, DlvType)
If Not 商品IO(fnInitial) Then Exit Sub
Call 商品IO(fnAllocTot, DataId)
If Not 伝票作成(DataId) Then Exit Sub '★2011/7/6 変更
Call 商品IO(fnAllocDtl, DataId, DlvCycle, DlvType)
Call 商品IO(fnPickLst, DataId, DlvCycle, DlvType)
Call 抽出繰越(DataId, OutDate, DlvCycle, DlvType)
Call 商品IO(fnEnd)
End Sub
●追加引当関連処理 リバイス
Sub 追加引当関連処理()
Dim sh As Worksheet
Dim shW As Worksheet
Dim z As Long
Dim i As Long
Dim DataId As String
Dim OutDate As String
Dim DlvCycle As String
Dim DlvType As String
For Each sh In ThisWorkbook.Worksheets
If sh.Name Like "引当繰越_*" Then
sh.Cells.Copy ThisWorkbook.Sheets("作業").Range("A1")
If 商品IO(fnInitial) Then
DataId = sh.Range("U1").Value '★2011/7/6 変更
OutDate = sh.Range("U2").Value '★2011/7/6 変更
DlvCycle = sh.Range("U3").Value '★2011/7/6 変更
DlvType = sh.Range("U4").Value '★2011/7/6 変更
Call 商品IO(fnAllocTot, DataId)
Call 商品IO(fnAllocDtl, DataId, DlvCycle, DlvType)
Call 商品IO(fnPickLst, DataId, DlvCycle, DlvType)
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Call 抽出繰越(DataId, OutDate, DlvCycle, DlvType)
Call 商品IO(fnEnd)
End If
End If
Next
End Sub
●抽出繰越 リバイス
Sub 抽出繰越(DataId As String, OutDate As String, DlvCycle As String, DlvType As String)
'作業シートの総量引当Ｘのものを引当繰越_xxxxx シートをコピー（自動生成）
Dim nSh As Worksheet
Application.ScreenUpdating = False
ThisWorkbook.Activate
With Worksheets("作業")
If WorksheetFunction.CountIf(.Columns("F"), "×") > 0 Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set nSh = ActiveSheet
.Range("Q1").Value = .Range("F1").Value '可否欄タイトル
.Range("Q2").Value = "×" '抽出条件
.Columns("A:O").AdvancedFilter xlFilterCopy, .Range("Q1").CurrentRegion, nSh.Range("A1")
.Range("Q1").CurrentRegion.Clear
With nSh
'オリジナル抽出条件保存
.Range("U1").Value = DataId '★2011/7/6 変更
.Range("U2").Value = OutDate '★2011/7/6 変更
.Range("U3").Value = DlvCycle '★2011/7/6 変更
.Range("U4").Value = DlvType '★2011/7/6 変更
.Name = getSheetName(ThisWorkbook, "引当繰越_" & Format(Now(), "yyyymmddhhnnss"))
End With
End If
End With
Application.ScreenUpdating = True
End Sub
●伝票作成 リバイス
Function 伝票作成(DataId As String) As Boolean '★2011/7/6 変更
'引数はテキストボックスや、コンボボックス入力を想定して文字列
'DataID "単品" かそれ以外か
Dim shG As Worksheet
Dim shW As Worksheet
Dim shD As Worksheet
Dim zz As Long
Dim z As Long
Dim i As Long
Dim x As Long
Dim wb As Workbook
Dim flag As Boolean
Dim fname As String
Dim fPath As String
Dim newFlag As Long
Dim ckBook As Workbook
Application.ScreenUpdating = False
Set shG = ThisWorkbook.Sheets("原紙 伝票")
Set shW = ThisWorkbook.Sheets("作業")
zz = shW.Range("B" & shW.Rows.Count).End(xlUp).Row - 1
If zz = 0 Then
MsgBox "データが抽出されていません"
Exit Function
End If
fPath = ThisWorkbook.Path & "\"
'12_05_28_単品
fname = Format(CDate(shW.Range("B2").Value), "yy""_""mm""_""dd") & "_" & DataId & ".xlsx"
On Error Resume Next
Set ckBook = Workbooks(fname)
On Error GoTo 0
If Not ckBook Is Nothing Then
MsgBox "まだエクセル上に" & fname & "が開かれたままになっています" & vbLf & _
"これを閉じてから実行してください"
Exit Function
End If
newFlag = 0
If Len(Dir(fPath & fname)) > 0 Then 'ブックが存在する
If MsgBox("すでに" & fname & "が存在します。既存ブックに追加しますか？", vbYesNo) = vbYes Then
Set wb = Workbooks.Open(fPath & fname)
Else
newFlag = 1
End If
Else
newFlag = 2
End If
z = zz \ 50
If zz Mod 50 > 0 Then z = z + 1
For i = 1 To z
If Not flag And newFlag <> 0 Then
shG.Copy
Set wb = ActiveWorkbook
If newFlag = 2 Then wb.SaveAs fPath & fname
flag = True
Else
shG.Copy After:=wb.Sheets(Sheets.Count)
End If
Set shD = ActiveSheet
x = (i - 1) * 50 + 2
With shD
.Range("C3").Value = Now()
.Range("I3").Value = shW.Range("C2").Value
.Range("G6").Value = shW.Range("D2").Value
.Range("C9:L58").Value = shW.Cells(x, "F").Resize(50, 10).Value
.Range("L60").Value = "P." & i 'ページ番号 場所は適切なところを指定
.Name = getSheetName(wb, CStr(i))
End With
Next
If newFlag <> 1 Then
Application.DisplayAlerts = False
wb.SaveAs fPath & fname
Application.DisplayAlerts = True
End If
Application.ScreenUpdating = True
MsgBox "伝票ブックを作成しました"
伝票作成 = True '★2012/7/6 追加
End Function
●商品IO
★最初のほうの変数定義に追加
Dim picName As String '★2012/7/6 追加
★で、Case fnPickLst のブロックを以下に。
Case fnPickLst '★2012/6/7 大幅変更
Application.ScreenUpdating = False
picName = "PickingList" & Format(Date, "yyyymmdd") & DlvType & DlvCycle
On Error Resume Next
Set picWB = Workbooks(picName & ".xlsx")
On Error GoTo 0
If Not picWB Is Nothing Then
ThisWorkbook.Sheets("原紙 ピッキング").Copy After:=picWB.Worksheets(picWB.Worksheets.Count)
DoEvents
Set picSh = picWB.Worksheets(picWB.Worksheets.Count)
Else
If Len(Dir(ThisWorkbook.Path & "\" & picName & ".xlsx")) > 0 Then
Set picWB = Workbooks.Open(ThisWorkbook.Path & "\" & picName & ".xlsx")
ThisWorkbook.Sheets("原紙 ピッキング").Copy After:=picWB.Worksheets(picWB.Worksheets.Count)
DoEvents
Set picSh = picWB.Worksheets(picWB.Worksheets.Count)
Else
ThisWorkbook.Sheets("原紙 ピッキング").Copy
Set picWB = ActiveWorkbook
Set picSh = ActiveSheet
End If
End If
picSh.Name = getSheetName(picWB, picName)
With picSh
.Range("E5").Value = DataId
.Range("J3").Value = DlvCycle
.Range("H5").Value = WorksheetFunction.SumIf(shW.Columns("F"), "○", shW.Columns("K"))
.Range("J5").Value = Date
.Range("L5").Value = Time
i = 10
For Each com In dicD
For Each dKey In dicD(com)
w = Split(dKey, vbTab)
com = w(0)
loc = w(1)
locSub = w(2)
zone = w(3)
w = dicD(com)(dKey)
qty = w(2)
If qty > 0 Then
.Cells(i, "D").Value = shZ.Cells(w(0), "F").Value
.Cells(i, "E").Value = zone
.Cells(i, "F").Value = loc
.Cells(i, "G").Value = locSub
.Cells(i, "H").Value = com
.Cells(i, "I").Value = shZ.Cells(w(0), "I").Value
.Cells(i, "J").Value = shZ.Cells(w(0), "J").Value
.Cells(i, "L").Value = qty
i = i + 1
End If
Next
Next
End With
Application.DisplayAlerts = False
picWB.SaveAs ThisWorkbook.Path & "\" & picName & ".xlsx"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
(ぶらっと)
ぶらっと様ありがとうございます。 今のところうまく行っています。 その前のご質問について書いてる途中だったのですが
＞ ・まず、伝票は、最初の伝票関連処理で○も×も作成。再引当では『作成しない』 ＞・ピッキングリストは最初の伝票関連処理でも、それ以降の再引当でも、○のもののみ作成。 すみません、確認しました。 上記の内容で大丈夫です。 再引当ての時は伝票は作成しないでいいです。
なので先日書きました「伝票シートで何日の分かわからないから～」という話は忘れてください… （最初の処理時しか伝票は作成しないので、C3セルの日付でいつの伝票か把握できるので…）
すみません、話が前後してしまいましたが、今の時点ではユーザーフォームで作成する伝票の種別・区分・便名・日付を ユーザーフォームで指定しています。 その時に「伝票関連処理」の部分を呼び出しているのですが、再引当ての場合に「伝票関連処理」をそのまま 呼び出すと再引当て分の伝票が作成されます。
>If Not 伝票作成(DataId) Then Exit Sub '★2011/7/6 変更 この部分を有効にして伝票を作成せずにピッキングリストだけを作る場合はどのようにすればよいでしょうか。
現在のユーザーフォームのコードは下記の通りです
Option Explicit
Private Sub UserForm_Initialize()
UserForm2.cbxSyubetu.List = Array("", "単品", "抱合せ")
UserForm2.cbxBin.List = Array("", "1便", "2便", "3便", "4便", "5便", "6便", "イレギュラー")
UserForm2.cbxKubun.List = Array("", "通常", "至急", "先日付", "マル進")
End Sub
Private Sub CommandButton1_Click()
Dim z As Long
If Me.cbxSyubetu.Text = "" Then
MsgBox "作成する伝票種別を選択してください", vbInformation
Exit Sub
End If
Call 伝票関連処理(cbxSyubetu.Value, txtDate.Value, cbxBin.Value, cbxKubun.Value)
End Sub
（にょろ）
すみません、次トピ立てました
（にょろ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.