[[20151015154911]] 『月ごとの使用数を転記したい。』（Lila） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『月ごとの使用数を転記したい。』（Lila）
以前はお世話になりました。
前回の追随のようなものになるのですが、再度ご教示お願いしたく、書き込ませていただきました。
以下のようなレイアウトのデータブック（アクセスより必要データをエクセルに落としたもの）から、結果ブックへ「月ごとの部品交換数」を転記したいのですが、前回より転記側の結果シートの紐付けは少なくなっているものの、日付の検索の仕方というか、日付の上下をどう検索の上転記するのかが解らず、質問させていただきました。
記載側の方でも、結果シートのレイアウトには1種類の「aaaaa」という商品しか記載していないのですが、これも前回同様で「新規のものは前から追加していく」（今回は「E」列）として、「AB」列より後ろには、データブック側にあるように「bbbbb」という商品や「ccc」「ddddd」「eeeee」と様々な商品が書いてあるとします。
なので、日付を例えば「F2」より小さい場合は「E」列の所定の場所（部品ｺｰﾄﾞと合致するセル）へという指定ができません･･･。
この場合は、どういったやり方があるでしょうか･･･？
ご教示頂けると大変助かります。
よろしくお願いします。
＜データブック＞
|[A] |[B] |[C] |[D]
[1]|解決日 |集計区分|部品ｺｰﾄﾞ |数量
[2]|2015/10/13|aaaaa |MP-M801432 | 16
[3]|2015/10/13|bbbbb |MP-M206006 | 1
[4]|2015/10/13|bbbbb |MP-OJ-6505-N2| 1
[5]|2015/09/13|bbbbb |MP-M207446 | 1
[6]|2015/09/13|bbbbb |MP-M009121 | 4
[7]|2015/09/13|ccc |MP-M004905 | 1
[8]|2015/08/13|ccc |MP-M007814 | 1
[9]|2015/08/13|dddddd |MP-TP-SX 2*4 | 1
＜結果ブック＞
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |
[1]|部品ｺｰﾄﾞ|品名|英語品名| | aaaaa |
[2]| | | | |2013/11|2013/12|2014/01|2014/02|2014/03|2014/04|2014/05|2014/06|2014/07|2014/08|2014/09|2014/10|2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[3]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[4]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[5]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[6]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
今回はデータブックのレイアウトは固定ですか？ それとも、【このようなレイアウト】ですか？
（β） 2015/10/15(木) 16:32
βさんこんばんは！
早速ありがとうございます。
今回のデータブックレイアウトは今の所これで固定ですが、今後もしかしたら「E」列に「金額」が増える可能性もあります。
その場合は、恐らく、結果ブックの方の日付の下に数値と金額を分けるか、まったく別のシートで数値を金額に変えるかという仕様になるかと思われます。
（Lila） 2015/10/15(木) 16:38
>>日付を例えば「F2」より小さい場合は「E」列の所定の場所（部品ｺｰﾄﾞと合致するセル）へという指定ができません･･･。
よくわからないのですが、たとえばデータブック側に aaaaa で 2013/10/15 といったものがあった場合 通常処理では転記該当場所がないのでスキップ。これを、どこかに転記したいのですか？ たとえばE列の左に列を自動的に挿入して？
★追加で。
2015/11/20 といったデータでも同様ですね。該当の場所がない。 どうしましょうか？
最初からaaaaa の最初の列を、"それ以前"、最後の列を "それ以降" としておけば、そこに突っ込むということもできると思いますけど。
>>今後もしかしたら「E」列に「金額」が増える可能性もあります。 >>その場合は、恐らく、結果ブックの方の日付の下に数値と金額を分けるか、まったく別のシートで数値を金額に変えるかという仕様になるかと思われます。
それでは、そこのところは、今回、無視でいいですね。
（β） 2015/10/15(木) 16:46
＞ よくわからないのですが、たとえばデータブック側に aaaaa で 2013/10/15 といったものがあった場合
＞ 通常処理では転記該当場所がないのでスキップ。これを、どこかに転記したいのですか？
＞ たとえばE列の左に列を自動的に挿入して？
その場合はスキップのままで大丈夫です。
一応過去2年分の年月を書いてありますが、恐らく「2014/10」より前は無いと思われます。（データをエクセルに拾い出せたのが「2014/10」までなので）
しかし、24ヶ月は、サイクルさせたいので、今は使用できなくとも今後左にずれて行くような格好で運用していきたいと考えています。
下記のようなイメージです。
＜今月＞
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |
[1]|部品ｺｰﾄﾞ|品名|英語品名| | aaaaa |
[2]| | | | |2013/11|2013/12|2014/01|2014/02|2014/03|2014/04|2014/05|2014/06|2014/07|2014/08|2014/09|2014/10|2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[3]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[4]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[5]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[6]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
＜来月＞
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |
[1]|部品ｺｰﾄﾞ|品名|英語品名| | aaaaa |
[2]| | | | |2013/12|2014/01|2014/02|2014/03|2014/04|2014/05|2014/06|2014/07|2014/08|2014/09|2014/10|2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|2015/11|
[3]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[4]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[5]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[6]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
＞それでは、そこのところは、今回、無視でいいですね。
はい、その方向で大丈夫です。
（Lila） 2015/10/15(木) 16:59
了解しました。 前回よりレイアウトが素直なので、ごくごく普通のコードでまかなえると思います。
ところで、データブックですが、前回同様、フォルダ内から複数選択、もしくはフォルダ内すべて といった抽出になりますか？
（β） 2015/10/15(木) 17:07
＞ 前回よりレイアウトが素直なので、ごくごく普通のコードでまかなえると思います。
＞ ところで、データブックですが、前回同様、フォルダ内から複数選択、もしくはフォルダ内すべて といった抽出になりますか？
前回は本当にありがとうございました＞＜
おかげさまで、運用できそうです！
今回のデータブックは、アクセスより抽出している為、このブックのみになります。
アクセスの方で更新があったら再度エクセルデータに抽出して、反映させていくという方法を考えています。
（結果ブックと同じ階層に格納しての運用が良いかな？と考えています）
（Lila） 2015/10/15(木) 17:13
了解です。
ところで、大事なことを確認していませんでした。
結果ブックのA列には、あらかじめ部品コードが記載されていて、データブックの当該部品を、その行に反映させるということでいいのでしょうか？ （結果ブック側になければ自動追加もできます）
それとも、毎回、チャラにして、まっしろなところから、データブックの情報だけで結果ブックを作成しなおすのでしょうか？
いずれの場合も、結果ブックの 部品コードは何行目からでしょうか？
（β） 2015/10/15(木) 17:25
＞ 結果ブックのA列には、あらかじめ部品コードが記載されていて、データブックの当該部品を、その行に反映させるということでいいのでしょうか？
＞ （結果ブック側になければ自動追加もできます）
前回同様、別のデータブックから取得します。
＞いずれの場合も、結果ブックの 部品コードは何行目からでしょうか？
3行目はフィルタ用に空白で取っておきたいので、
データ入力は4行目からになります。
（Lila） 2015/10/15(木) 20:54
お試しください。 念のため各ブックのシートのキー項目、Trim関数で、先頭や末尾のスペースはコード内で除去しています。
10/16 0:27 使わなかった変数定義をカット
Sub 更新処理()
Const DBOOKNM As String = "データブック.xlsx" '★実際の名前に
Dim dicH As Object
Dim dicV As Object
Dim mxCol As Long
Dim mxRow As Long
Dim nRows As Long
Dim nCols As Long
Dim vntD As Variant
Dim shT As Worksheet
Dim shF As Worksheet
Dim c As Range
Dim k1 As String
Dim k2 As String
Dim x As Long
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
'結果シート規定
Set shT = ThisWorkbook.Sheets("Sheet1")
Set dicH = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書
Set dicV = CreateObject("Scripting.Dictionary") '結果シート部品コード辞書
mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの１行目のデータ最終列を求める
mxCol = mxCol + shT.Cells(1, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して､表の最終列を求める
mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行
nRows = mxRow - 3 '結果シートの品番数
nCols = mxCol - Columns("E").Column + 1 '表の列数
vntD = shT.Range("E4").Resize(nRows, nCols).Value '結果シート既存の値を配列に取り込み
For Each c In shT.Range("E1").Resize(, nCols) '1行目のセルを１つずつ取り出す
k1 = Trim(c.MergeArea(1).Value) '部品コード
k2 = Format(c.Offset(1).Value, "yyyymm") '年月
x = x + 1
dicH(k1 & vbTab & k2) = x '集計区分と年月を見出しに、配列内行番号を辞書登録
Next
x = 0
For Each c In shT.Range("A4").Resize(nRows) 'A列の部品コードを取り出す
x = x + 1
dicV(Trim(c.Value)) = x
Next
'データブックの読み込み
Set shF = Workbooks.Open(ThisWorkbook.Path & "\" & DBOOKNM).Sheets("Sheet1")
'データブックのA列データの取得
For Each c In shF.Range("A2", shF.Range("A" & shF.Rows.Count).End(xlUp))
With c.EntireRow
k1 = Trim(.Columns("B").Value) '部品コード
k2 = Format(.Columns("A").Value, "yyyymm") '年月
i = dicV(Trim(.Columns("C").Value)) '集計区分
j = dicH(k1 & vbTab & k2)
If i <> 0 And j <> 0 Then vntD(i, j) = .Columns("D").Value '行、列の登録あれば数量を格納
End With
Next
shF.Parent.Close False 'データブックを閉じる
shT.Range("E4").Resize(UBound(vntD, 1), UBound(vntD, 2)).Value = vntD '結果を上書き
End Sub
（β） 2015/10/15(木) 23:18
βさん
今回もありがとうございます！
一発で出来ました^o^!!
年月の箇所で、上のほうと下のほうで、これはどういう処理をしているのですか？
（Lila） 2015/10/16(金) 08:52
すみません、この後の処理で今度は前回の結果ブックと、今回の結果ブックを使用して、グラフを作成したいのですが前段階の数値精査はVBAで可能でしょうか？
（Lila） 2015/10/16(金) 14:11
新しいレイアウトでの対応コメントがアップされたので、それを受けたコメントを書いたのですが 削除されたようですね。
でも、質問されたことのヒントになると思いますので、そのままアップします。
まず、aaaaaa が入った結合セルですが、2行目になったわけですから、ずっと上のほうの mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの１行目のデータ最終列を求める ここも 1行目ではなく、2行目を相手にするように変更必要ですね。
で、今回の処理、まず、結果シートの数値部分、アップされた例でいえば E5:AZ11 ですけど、これを 配列 vntD で管理します。7行、48列になりますね。 集計区分と年月で その配列の列を構成するわけですけど、aaaaaaと201411 が 1(列目)、aaaaaaと201412 が2(列目) と 配列内の列番号をdicHに登録します。 同様に、その下で 部品コードが配列の何行目になるかをdicVに登録しています。 MP-M015001 は 1(行目)、MP-M603760 は 2(行目) となっています。
データブックのデータの部品番号や、集計コードと年月を加えたもので、DicV、dicHを参照し、 そこから、セットすべき配列内の行と列を取得しています。
ところで、コードを書いていて気になったことがあります。 データブックに 結果シート上、同じマス目に入るデータが複数あった場合、現行のコードは、あとのほうで置き換えになります。 置き換えではなく加算が必要なら
If i <> 0 And j <> 0 Then vntD(i, j) = .Columns("D").Value '行、列の登録あれば数量を格納
ここを
If i <> 0 And j <> 0 Then vntD(i, j) = vntD(i, j) + .Columns("D").Value '行、列の登録あれば数量を格納
にしてください。
>>グラフを作成する前段階の数値精査はVBAで可能でしょうか
もちろん可能だと思いますが、数値精査とは具体的にどんなものでしょうか？ こういった数値になっているはずだという、それを、そうなっているかどうかのチェックなんですよね？ そのチェック条件を教えていただけますか？
（β） 2015/10/16(金) 14:23
レイアウトを変更してみたものの、大項目部分でグラフを作るのは、結局中項目部分を一度全て抽出して、足していくだけでいいのでは･･･と考え直したので、レイアウトはそのままにする事にしました。
言い出しておいて、申し訳ないです；
ですが、今後のためにも参考にさせて頂きたいので、質問続行させて下さい。
＞ まず、aaaaaa が入った結合セルですが、2行目になったわけですから、ずっと上のほうの
＞ mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの１行目のデータ最終列を求める
＞ ここも 1行目ではなく、2行目を相手にするように変更必要ですね。
ここの数値「1」は1行目の「1」という解釈で良いのでしょうか？
＞ で、今回の処理、まず、結果シートの数値部分、アップされた例でいえば E5:AZ11 ですけど、これを
＞ 配列 vntD で管理します。7行、48列になりますね。
＞ 集計区分と年月で その配列の列を構成するわけですけど、aaaaaaと201411 が 1(列目)、aaaaaaと201412 が2(列目) と 配列内の列番号をdicHに登録します。
＞ 同様に、その下で 部品コードが配列の何行目になるかをdicVに登録しています。
＞ MP-M015001 は 1(行目)、MP-M603760 は 2(行目) となっています。
＞ データブックのデータの部品番号や、集計コードと年月を加えたもので、DicV、dicHを参照し、
＞ そこから、セットすべき配列内の行と列を取得しています。
と言うことは、上記の箇所とセル指定のある箇所を修正すれば、他は特に変更の必要がない？？のでしょうか？？
＞ところで、コードを書いていて気になったことがあります。
＞ データブックに 結果シート上、同じマス目に入るデータが複数あった場合、現行のコードは、あとのほうで置き換えになります。
これは「E2」に「2014/11」が入っていたとき「E5」に「4」が入っていて、これが、次月になった際「E2」には「2014/12」が入るとして「E5」に前月「E6」に入っていた「1」を加算するのか、それとも「1」に置き換えるのか？という意味でしょうか？
そういう意味でしたら、置き換えのままで問題ありません＾＾
＞ もちろん可能だと思いますが、数値精査とは具体的にどんなものでしょうか？
＞ こういった数値になっているはずだという、それを、そうなっているかどうかのチェックなんですよね？
＞ そのチェック条件を教えていただけますか？
前回の結果ブックは「商品に対する材料の使用数」のデータで Aブック とします。
今回の結果ブックは（壊れたり、不備で使用できないなどで）「月毎に交換した材料の数値」のデータで Bブックとします。
レイアウトの「aaaaa」を例にします。
１.「Bブック」のデータで、一番右の最新月（12ヶ月単位にしたので、この場合「P」列）で「降順」処理をして一番交換された部品から順番に並べ替えます。
２.半年分を遡って、「Aブック」のその材料の「aaaaa」での「使用数」を検索する。
-これが直近の月で「+2」以上が2ヶ月以上連続して続いていたならその部品ｺｰﾄﾞと品名、記載されている12か月分のデータを「Bブック」の別のシートへ記載する。
※仮に「5行目」で異常と判断された場合、「aaaaa」の「5行目」を「A5：P5」で転記 というイメージです。
-「使用数」と比べ、毎月安定していたものが突然増えたデータを「Bブック」の別のシートへ記載する。
※それまで「1」が続いていたのに突然「8」となり次月は再び「1」に戻る等の場合。（使用数：1の場合）
-「使用数」と比べ、「+2」以上だった数値が範囲内になったデータを「Bブック」の別のシートへ記載する。
-「使用数」と比べ「+2」以上がずっと続いている
３.これをBシート大項目ごとに実行
と言うようなチェック条件になります。
（２番目の４つめの条件をど忘れしてしまったので、思い出し次第編集させて頂きます；；）
ちなみに、Aシートの方で大項目〜形状の条件のものがありますが、中項目以下行で全てを足した使用数にて、計算するという事は可能でしょうか？
例えば「クッキー＞プレーン＞5枚＞箱」で「MP-M801432」のものが「1」の使用数だったとします。
「クッキー＞プレーン＞5枚＞袋」でも「クッキー＞プレーン＞10枚＞箱」でも「クッキー＞プレーン＞10枚＞袋」でも全て「1」の使用数でした。
なので「クッキー＞プレーン」で「MP-M801432」の使用数は「4」という事での計算という意味になります。
（Lila） 2015/10/16(金) 15:54
条件処理を追加 16：36
少しずつコメントします。
●ここの数値「1」は1行目の「1」という解釈で良いのでしょうか？
mxCol = mxCol + shT.Cells(1, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して､表の最終列を求める
この shT.Cells(1, mxCol) の 1 が 1行目ということになります。
●と言うことは、上記の箇所とセル指定のある箇所を修正すれば、他は特に変更の必要がない？？のでしょうか？？
レイアウトに影響があるところは
mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行
nRows = mxRow - 3 '結果シートの品番数
nCols = mxCol - Columns("E").Column + 1 '表の列数
vntD = shT.Range("E4").Resize(nRows, nCols).Value '結果シート既存の値を配列に取り込み
For Each c In shT.Range("E1").Resize(, nCols) '1行目のセルを１つずつ取り出す
For Each c In shT.Range("A4").Resize(nRows) 'A列の部品コードを取り出す
For Each c In shF.Range("A2", shF.Range("A" & shF.Rows.Count).End(xlUp))
k1 = Trim(.Columns("B").Value) '部品コード
k2 = Format(.Columns("A").Value, "yyyymm") '年月
i = dicV(Trim(.Columns("C").Value)) '集計区分
shT.Range("E4").Resize(UBound(vntD, 1), UBound(vntD, 2)).Value = vntD '結果を上書き
これぐらいだと思います。要は、Range や Cells や Columns といったもので、固定で列や行を与えているところが 要チェックですね。
●これは「E2」に「2014/11」が入っていたとき「E5」に「4」が入っていて・・・・・
たとえばデータブックに
|2015/09/13|bbbbb |MP-M009121 | 4 |2015/09/15|bbbbb |MP-M009121 | 8
こんなデータがありうるとすれば、bbbbbb の MP-M00912 の 9月が 12 ですね。 現行のコードでは置換なので、下のほうの 8 が採用され結果が 8 になってしまうということです。
★以降の数値精査については、これからじっくり読んでみます。
（β） 2015/10/16(金) 17:05
少し混乱しています。
【前回の】結果ブック、【今回の】結果ブックですが、
・（Lila） 2015/10/15(木) 16:59 の投稿にある、前月と今月の、それぞれのブックですか？ ・それとも、【前トピ】の 大項目〜形状 まであるブックと、【このトピ】のブックのことですか？
（β） 2015/10/16(金) 18:58
詳しく説明頂いてありがとうございます！
コードを見ながら、その辺りをチェックしてみます。
＞ こんなデータがありうるとすれば、bbbbbb の MP-M00912 の 9月が 12 ですね。
＞ 現行のコードでは置換なので、下のほうの 8 が採用され結果が 8 になってしまうということです。
なるほど。それでは、加算の方になるので、修正させて頂きます！
＞【前回の】結果ブック、【今回の】結果ブックですが、
これは、
＞ ・それとも、【前トピ】の 大項目〜形状 まであるブックと、【このトピ】のブックのことですか？
こちらになります。
ややこしい書き方で申し訳ありません；
（Lila） 2015/10/18(日) 11:56
前回、今回については理解しました。 これから要件を整理していきますが、その過程で疑問がでれば、質問アップしますのでよろしく。
ところで、アップ済みのコードでもう１点、気になることが。
現在のコードは、実行前に、結果シートに値があれば、それを活かすというか、まず、今ある値を取り込んで そこに、データシートから【加算】をします。 データシートに同じマス目のデータが２件あって 4 と 8 なら、12 と、これは確認もらっていますが 実行前に、そのマス目に数字が入っていたとします。たとえば 10。そうすると、その 10 に対して、データブックの 4 と 8 が加算されますので、10+4+8 で 22になります。
別の方法としては、処理前に、結果ブックの数字が入っている領域をすべてクリアしてから開始する。 そうすれば 0 + 4 + 8 =12 になります。
ただ、この方法だと、今回のデータブックにない、過去に更新された数字までがクリアされてしまいます。
もう１つの方法としては、今回のデータブックに存在するマス目だけをクリアして、今回のデータブックの数字を反映（加算）する。
いずれがよろしいですか？
（β） 2015/10/18(日) 16:16
＞これから要件を整理していきますが、その過程で疑問がでれば、質問アップしますのでよろしく。
はい、了解しました！
＞ただ、この方法だと、今回のデータブックにない、過去に更新された数字までがクリアされてしまいます。
そうですね、必ずしもデータブックに存在している訳ではないので、後者の方法が望ましい気がします。
＞ もう１つの方法としては、今回のデータブックに存在するマス目だけをクリアして、今回のデータブックの数字を反映（加算）する。
こちらの方法の方が、データ精査的には確実なものになるのかなと思います。
（Lila） 2015/10/18(日) 17:03
なかなか、すんなりとはイメージが頭に入ってきません。
・前回の結果シート（Aシート) ですが、今回の Bシートでいう aaaaaa は、どれにあたりますか？
・ 「Bブック」のデータで、一番右の最新月（12ヶ月単位にしたので、この場合「P」列）で「降順」処理をして一番交換された部品から順番に並べ替えます。
この P列というのがアップされたサンプルからはわかりにくいのですが、たとえば aaaaaaの最後の年月ということでしょうか？ で、降順処理というのは、その最新月だけで行うのですか？ あるいは、それを含む過去６か月の合計で降順処理ですか？ そもそもが、なぜ降順処理が必要なんでしょうか？
・ ２.半年分を遡って、「Aブック」のその材料の「aaaaa」での「使用数」を検索する。
Aシートの aaaaaa が、どれに相当するのか、これはすでに質問しましたが、さらに、【半年分】というのは、前回の結果ブックの半年分ということでしょうか？
・根本的には、やはり、何をチェックするのか、どのようにチェックするのか、そこで異常だと判断すれば、具体的にどんなレイアウトにまとめて どこに記載するのか、それは、新規に記載するのか、追加で記載するのか、そのあたりが、やはりわかりません。 基本的に、βがＡブックとＢブックの関連を理解していないからだと思いますが。
・【たとえば 1 が続いていて あるとき 8 になって、次の月に 1 にもどった】というのは、うん、異常なんだろうなと思いますけど これを【ルール】として記載するとどうなるんでしょう？ たとえば あるとき 5 になって 次に 2 になったのは いいのか、悪いのか？ さらに、ずっと というのは 2か月なんだろうか、4か月なんだろうか とかとか。 また、ずっと 1 が続いて、最新の状態で 8 になった。でも来月（未処理）は 1 に戻るかもしれない。これは、どう判断するのか。
等々、現在、Lilaさんが目視でチェックしておられる、そのチェック基準を、網羅して説明いただかないと、コード化は無理ですねぇ。
それとは別に、
>>ちなみに、Aシートの方で大項目〜形状の条件のものがありますが、中項目以下行で全てを足した使用数にて、計算するという事は可能でしょうか？
大項目（クッキー 等）単位で 部品別使用数の把握ですね。 はいできますよ。 たとえば前回の結果シート作成処理で、SHeet2 といったものに、SHeet1 の 大項目ごとの部品使用表というものを、追加で作成することは可能です。 やりましょうか？
>>＞ もう１つの方法としては、今回のデータブックに存在するマス目だけをクリアして、今回のデータブックの数字を反映（加算）する。 >こちらの方法の方が、データ精査的には確実なものになるのかなと思います。
これについては、後ほど、修正版をアップします。
（β） 2015/10/18(日) 19:39
＞・前回の結果シート（Aシート) ですが、今回の Bシートでいう aaaaaa は、どれにあたりますか？
これは、Aシートでいう所の「大項目+中項目」になります。
＞ ・ 「Bブック」のデータで、一番右の最新月（12ヶ月単位にしたので、この場合「P」列）で「降順」処理をして一番交換された部品から順番に並べ替えます。
＞ この P列というのがアップされたサンプルからはわかりにくいのですが、たとえば aaaaaaの最後の年月ということでしょうか？
すいません；
また明日、ちゃんとしたサンプルをUPしますね！
「最新月」になります。
それぞれの項目の「最新月」と言う事ですね。
＞ で、降順処理というのは、その最新月だけで行うのですか？ あるいは、それを含む過去６か月の合計で降順処理ですか？
＞ そもそもが、なぜ降順処理が必要なんでしょうか？
降順処理は、最新月のみで行います。
なぜこの処理が必要かというと、そのグラフにしたいことそのままなのですが、
・使用部品と交換部品を比べて明らかに多いもの
・突然多くなったもの
・多くなったけど終息してきたもの
・ずっと多いもの
これを見たいからです。
この商品に使われている、この部品がおかしいのかな？最近この部品がおかしいぞ？この部品が直ってきたけど、今度はこっちがおかしいぞ？
という事が、一目で解るようにしたいと言いますか…
＞・ ２.半年分を遡って、「Aブック」のその材料の「aaaaa」での「使用数」を検索する。
＞ Aシートの aaaaaa が、どれに相当するのか、これはすでに質問しましたが、さらに、【半年分】というのは、前回の結果ブックの半年分ということでしょうか？
前回のものは、その商品にどの部品がどのくらい使用されているかという事を知る為のものなので、半年分の計算をするのは、今回の交換した部品に対して、となります。
＞・根本的には、やはり、何をチェックするのか、どのようにチェックするのか、そこで異常だと判断すれば、具体的にどんなレイアウトにまとめて
＞ どこに記載するのか、それは、新規に記載するのか、追加で記載するのか、そのあたりが、やはりわかりません。
＞ 基本的に、βがＡブックとＢブックの関連を理解していないからだと思いますが。
イメージとしては、Bブックの「Sheet2」に異常があったものをそのまま転記する…という感じですが、これもまた明日レイアウトサンプルをUPさせて頂きたいと思います。
＞・【たとえば 1 が続いていて あるとき 8 になって、次の月に 1 にもどった】というのは、うん、異常なんだろうなと思いますけど これを【ルール】として記載するとどうなるんでしょう？
基本的には、最新月から半年分の情報で、Aシートで見た使用数と比べて、
・2カ月以上、多い
・多かったけど減ってきた
・突然多くなったけど次の月は戻った
・4カ月以上多いまま
というのがルールになりますが、
＞ たとえば あるとき 5 になって 次に 2 になったのは いいのか、悪いのか？
この場合、Aシートでの使用数が「１」もしくは「２」だった場合は「５」は異常だという判断になります。
上記ルールの ・突然多くなったけど次の月は戻った というルールに適応されるかと思います。
＞ さらに、ずっと というのは 2か月なんだろうか、4か月なんだろうか とかとか。
グラフイメージを添付出来れば一番早い気がしますね…
＞ また、ずっと 1 が続いて、最新の状態で 8 になった。でも来月（未処理）は 1 に戻るかもしれない。＞これは、どう判断するのか。
ずっと1が続く、という事で此処での場合、この部品の使用数は「1」という例になりますが、この場合は最新月の時点では目視では「ん？」となりますが、様子見項目となり次月に数値が入って、初めて異常と判断されるルールになります。
次月で「1」に戻れば、先程と同じく「・突然多くなったけど次の月は戻った」のルールに適応されますし、「3」以上の数値が入れば「・2カ月以上、多い」のルールに適応されます。
＞ >>ちなみに、Aシートの方で大項目〜形状の条件のものがありますが、中項目以下行で全てを足した使用数にて、計算するという事は可能でしょうか？
＞ 大項目（クッキー 等）単位で 部品別使用数の把握ですね。
大項目+中項目（クッキー＞プレーン 等）ですが、こちらも可能ですか？
＞ たとえば前回の結果シート作成処理で、SHeet2 といったものに、SHeet1 の 大項目ごとの部品使用表というものを、追加で作成することは可能です。
＞ やりましょうか？
上記の大項目+中項目での転記が可能であるならば、お願いしたいです。
その方が、今回との関連処理は恐らく簡潔になるような気がするのですが、大した違いはないでしょうか？
あ、それと、レイアウトの件なのですが、「aaaaa」は前回でいう所の「大項目+中項目」なので記述的には「クッキープレーン」というようなものなのですが、この場合2行に分けて記述しないと比較は無理なのでは…と思ったのですが…この辺りはどうなのでしょう？？
＞ >>＞ もう１つの方法としては、今回のデータブックに存在するマス目だけをクリアして、今回のデータブックの数字を反映（加算）する。
＞ >こちらの方法の方が、データ精査的には確実なものになるのかなと思います。
＞ これについては、後ほど、修正版をアップします。
ありがとうございます＞＜
お手数おかけしますが、お願いいたします。
（Lila） 2015/10/18(日) 22:22
>>＞ これについては、後ほど、修正版をアップします。
以下、修正版です。
Sub 更新処理()
Const DBOOKNM As String = "データブック.xlsx" '★実際の名前に
Const STLINE As Long = 4 '結果ブックの部品コード開始行
Dim dicH As Object
Dim dicV As Object
Dim mxCol As Long
Dim mxRow As Long
Dim nRows As Long
Dim nCols As Long
Dim vntD As Variant
Dim shT As Worksheet
Dim shF As Worksheet
Dim c As Range
Dim k1 As String
Dim k2 As String
Dim x As Long
Dim i As Long
Dim j As Long
Dim done As Object
Application.ScreenUpdating = False
'結果シート規定
Set shT = ThisWorkbook.Sheets("Sheet1")
Set dicH = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書
Set dicV = CreateObject("Scripting.Dictionary") '結果シート部品コード辞書
Set done = CreateObject("Scripting.Dictionary") '当該キーのデータ更新辞書
mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの１行目のデータ最終列を求める
mxCol = mxCol + shT.Cells(1, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して､表の最終列を求める
mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行
nRows = mxRow - 3 '結果シートの品番数
nCols = mxCol - Columns("E").Column + 1 '表の列数
vntD = shT.Range("E4").Resize(nRows, nCols).Value '結果シート既存の値を配列に取り込み
For Each c In shT.Range("E1").Resize(, nCols) '1行目のセルを１つずつ取り出す
k1 = Trim(c.MergeArea(1).Value) '部品コード
k2 = Format(c.Offset(1).Value, "yyyymm") '年月
x = x + 1
dicH(k1 & vbTab & k2) = x '集計区分と年月を見出しに、配列内行番号を辞書登録
Next
x = 0
For Each c In shT.Range("A4").Resize(nRows) 'A列の部品コードを取り出す
x = x + 1
dicV(Trim(c.Value)) = x
Next
'データブックの読み込み
Set shF = Workbooks.Open(ThisWorkbook.Path & "\" & DBOOKNM).Sheets("Sheet1")
'データブックのA列データの取得
For Each c In shF.Range("A2", shF.Range("A" & shF.Rows.Count).End(xlUp))
With c.EntireRow
k1 = Trim(.Columns("B").Value) '部品コード
k2 = Format(.Columns("A").Value, "yyyymm") '年月
i = dicV(Trim(.Columns("C").Value)) '集計区分
j = dicH(k1 & vbTab & k2)
If i <> 0 And j <> 0 Then
If Not done.exists(i & vbTab & j) Then vntD(i, j) = Empty
done(i & vbTab & j) = True
vntD(i, j) = vntD(i, j) + .Columns("D").Value '行、列の登録あれば数量を格納
End If
End With
Next
shF.Parent.Close False 'データブックを閉じる
shT.Range("E4").Resize(UBound(vntD, 1), UBound(vntD, 2)).Value = vntD '結果を上書き
End Sub
（β） 2015/10/19(月) 00:42
まず、昨日書き込んだレイアウトをUPします。
＜Bブック（Sheet1）レイアウト＞
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |
[1]|部品ｺｰﾄﾞ|品名|英語品名| | aaaaa |
[2]| | | | |2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[3]| | | | | | | | | | | | | | | | |
[4]| | | | | | | | | | | | | | | | |
[5]| | | | | | | | | | | | | | | | |
[6]| | | | | | | | | | | | | | | | |
＜Bブック（Sheet2)出力イメージ＞
・Bブック（Sheet1）で以下のような結果だったとします
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |
[1] |部品ｺｰﾄﾞ |品名 |英語品名 | | aaaaaa |
[2] | | | | | | | | | | | | | | | | |
[3] | | | | |2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[4] | | | | | | | | | | | | | | | | |
[5] |MP-M015001|abcdeeeeessssa | | | 4| 1| 1| 4| 1| 4| 8| 8| 8| 8| 8| 8|
[6] |MP-M015372|sdfhrlaaaaaa | | | 1| 1| 1| 2| 1| 1| 2| 1| 1| 1| 2| 2|
[7] |MP-M603760|hsummmssann | | | 2| | 2| 2| | 2| 2| 2| 2| 2| 2| 2|
[8] |MP-M905240|mmmmkkkjkiuuuuu | | | 2| 2| 2| 2| 2| 2| 2| 2| 2| 2| 2| 2|
[9] |MP-1033477|lkuddsjoueeeeesa | | | | | | 1| | | 1| 8| 9| | | 1|
[10]|MP-E000019|amsdbauiddddfvn | | | 1| 1| 1| 1| 1| 1| 1| 1| 1| 1| 1| 1|
[11]|MP-E103961|dsuioeblvlsm,,,,,nn| | | | | | | 1| | | | | | | 1|
・Bブック（Sheet2）にはこう出力されるイメージです
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |
[1] |部品ｺｰﾄﾞ |品名 |英語品名 | | aaaaaa |
[2] | | | | | | | | | | | | | | | | |
[3] | | | | |2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[4] | | | | | | | | | | | | | | | | |
[5] |MP-M015001|abcdeeeeessssa | | | 4| 1| 1| 4| 1| 4| 8| 8| 8| 8| 8| 8|
[6] |MP-M015372|sdfhrlaaaaaa | | | 1| 1| 1| 2| 1| 1| 2| 1| 1| 1| 2| 2|
[7] |MP-1033477|lkuddsjoueeeeesa | | | | | | 1| | | 1| 8| 9| | | 1|
＜出力したいグラフのイメージ＞
・灰色：ずっと高い
・黄色：突然上がり下がった
・青色：収束してきた
・緑色：上昇傾向にある
という例のものです。
コードの修正ありがとうございます！
これから、検証してみます！
（Lila） 2015/10/19(月) 09:25
前回、今回の精査比較については、まだ理解の途中です。
その前に、前回比較シートの集約版作成コードを。そちらのイメージに合わなければ指摘願います。 効率的な処理としては、データ取り込み 内にコード追加なんですが、それだと、非常にごちゃつきますので できあがった結果シート(Sheet1) を参照して集約シート(Sheet2) に展開します。 シートレイアウトが変更になれば両方をメンテナンスしなければいけなくなるわけですが、運用としては この構えのほうが扱いやすいと思いまして。
たとえば 使用数更新1 の Application.ScreenUpdating = true の 上に Call 使用量集計 といれて使うなり これはこれで単独で使うなり、そちらの運用に合わせてどうぞ。
Sub 使用量集計()
Dim shT As Worksheet
Dim shS As Worksheet
Dim mxCol As Long
Dim mxRow As Long
Dim nCols As Long
Dim nRows As Long
Dim vntT As Variant
Dim k1 As String
Dim k2 As String
Dim dicX As Object
Dim dicH As Object
Dim x As Long
Dim y As Long
Dim c As Range
Dim r As Range
Dim n As Range
Dim k As Variant
Application.ScreenUpdating = False
'結果シート処理
Set shT = ThisWorkbook.Sheets("Sheet1") '結果シート
Set shS = ThisWorkbook.Sheets("Sheet2") '集計シート
Set dicH = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書(列番号->大中項目名)
Set dicX = CreateObject("Scripting.Dictionary") '結果シート列タイトル辞書(大中項目名->1からの連番)
mxCol = shT.Cells(1, Columns.Count).End(xlToLeft).Column '結果シートの１行目のデータ最終列を求める
mxCol = mxCol + shT.Cells(1, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して､表の最終列を求める
mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行
nRows = mxRow - 4 '結果シートの品番数
nCols = mxCol - Columns("F").Column + 1 '表の列数
For Each c In shT.Range("F1").Resize(, nCols) '1行目のセルを１つずつ取り出す
k1 = c.MergeArea(1).Value '先頭行キー
k2 = c.Offset(1).MergeArea(1).Value '2行目キー
dicH(c.Column) = k1 & k2 '列番号を見出しに、その列タイトルを辞書登録
If Not dicX.exists(k1 & k2) Then '列タイトルを見出しに連番セット
x = x + 1
dicX(k1 & k2) = x
End If
Next
ReDim vntT(1 To nRows, 1 To dicX.Count) '集計表領域サイズの配列
y = 0
For Each r In shT.Range("A5").Resize(nRows) '結果シートの品番取り出し ●
y = y + 1 '配列内行番号
For Each c In r.EntireRow.Range("F1").Resize(, nCols) 'その行の数値取り出し
If Not IsEmpty(c) Then 'そのセルに値があれば
k = dicH(c.Column) 'その数値の項目キー
x = dicX(k) '配列内列番号
vntT(y, x) = vntT(y, x) + c.Value '集約表配列に足し込み
End If
Next
Next
'集約シート作成
shS.UsedRange.ClearContents
shS.Range("A2").Resize(nRows).Value = shT.Range("A5").Resize(nRows).Value '品番
shS.Range("B1").Resize(, dicX.Count).Value = dicX.keys '大中項目キー
shS.Range("B2").Resize(UBound(vntT, 1), UBound(vntT, 2)).Value = vntT '集約表
shS.Select
End Sub
（β） 2015/10/19(月) 16:36
βさん、いつもありがとうございます。
今朝の修正版のコードは、目視確認した限りは問題なく加算されているようです。
今から元データで数値を見てみます。
集約の方のコードもありがとうございます！
こちらもバッチリでした！
ただ、比較する品番列が今回は「MP-」付きなので、B列に修正してみました。
＞mxRow = shT.Range("A" & Rows.Count).End(xlUp).Row '結果シートの品番最終行
ここと
＞For Each r In shT.Range("A5").Resize(nRows) '結果シートの品番取り出し ●
ここと
＞ shS.Range("A2").Resize(nRows).Value = shT.Range("A5").Resize(nRows).Value '品番
ここの後ろの方の「A5」をそれぞれ「B」、「B5」に修正したのですが、これで合っていますか？
（※出力は出来ていましたが、念のため･･･）
＞たとえば 使用数更新1 の Application.ScreenUpdating = true の 上に Call 使用量集計 といれて使うなり
この箇所にコールコードを入れておけば、更新したときに随時Sheet2も更新できるということですか？
（Lila） 2015/10/19(月) 16:57
A-->B は、そちらの対応（3か所）でＯＫかと思います。
>>この箇所にコールコードを入れておけば、更新したときに随時Sheet2も更新できるということですか？
はい、そうなります。 で、そのようにしておけば、常に Sheet1 と Sheet2 が同期がとれていることになりますから 数値精査上の前回は、このSheet2 を使ったほうがやりやすいんでしょうね。
（β） 2015/10/19(月) 17:08
＞ A-->B は、そちらの対応（3か所）でＯＫかと思います。
ありがとうございます^o^*
ちゃんと動いてくれると楽しいですね！
＞ >>この箇所にコールコードを入れておけば、更新したときに随時Sheet2も更新できるということですか？
＞ はい、そうなります。
＞ で、そのようにしておけば、常に Sheet1 と Sheet2 が同期がとれていることになりますから
なるほどです。
そうですね、別々にしておくと、片方を忘れてしまったり･･･などあるかもしれませんので、コールコードを検索して入れてみます！
（Lila） 2015/10/19(月) 17:15
製造業の業務知識がないので、グラフを見れば、あぁ、そうだね、これは、ちょっと異常なんだろうねと そう思えるのですが、じゃぁ、数多くのデータの中から、異常データをピックアップするルールとなると さて、どうしたらいいんだろうと、悩んでしまいます。というか、悩んでもわからないので、それらルールを すべて網羅してみらえれば、コード化のお手伝いはできるでしょうけど。
>>Aシートでの使用数が「１」もしくは「２」だった場合は「５」は異常だという判断になります
ですよね。でも逆に考えると、Aシートの使用数が 1000 だった場合は、きっと 5 っていうのは誤差の範囲で正常？ ということは、使用数に応じて、どれぐらいを異常と見るかの尺度があるんだろうなと。 これは一律、% で考えるのか、使用数によってそれぞれ決められるのか、それはわからないんですが。
また、1か月で復帰というところも、かりに2か月で復帰したとしても、復帰に2か月かかったけど、やっぱり異常では？ さらに、ずっと 1 だったものが、ある月に いきなり 100 になって、これが復帰せず、ずっと続くのも異常じゃないかな？
Aブックの数字と、Bブックのどこをチェックするのかも、実は、まだわかっていませんし、降順というのも、 横に日付別に並んだ数字を降順にするのか、縦に部品別に並んだ数字を降順にするのか、わかっていません。 そもそもが、なぜ降順にするのかが、ピンとこないんです。
たとえば発想をかえて、【正常な状態】とはどんな状態かを定義してもらう。 そうすれば、それ以外が異常なものとしてピックアップできるかもしれません。
毎月の数値の範囲は、これぐらいだとか、（つまり、それ以上の上下があれば異常） この範囲からはずれる数値が、期間的にこれぐらいなら 正常（つまり、それより長く続くと異常）
そういった定義はできませんか？
（β） 2015/10/20(火) 08:19
おはようございます。
＞また、1か月で復帰というところも、かりに2か月で復帰したとしても、復帰に2か月かかったけど、やっぱり異常では？
ええと、この場合だとグラフでいうと「青色」の異常になります。
＞ さらに、ずっと 1 だったものが、ある月に いきなり 100 になって、これが復帰せず、ずっと続くのも異常じゃないかな？
この場合は、グラフでいうと「緑色」になります。
AブックとBブックで比較グラフの問題は、私も理解が追いついていない部分があるといえばあるので、もう一度精査させてください。
考えてくださったのに、申し訳ないです･･･；
それとは別の話といいます、前段階？になると思いますが、少しよろしいでしょうか？
今回作成したもので、現在登録が17種類あり、さらにそれを仲間別と言うか･･･大きなくくりにすると、7種類あります。
これを同じブックのシート別に数値の入った箇所だけ行ごと抜き出す、という事は可能でしょうか？
現時点では「E〜AZ」「BA〜BL]「BM〜BX」「BY〜DH」「DI〜FD」「FE〜GB」「GC〜GZ」が７つの大きなくくりになっています（レイアウトどおり、1種類は12列）
今後、増える可能性もある（1種類にひとつしか無いものも含んでいる為）ので、関数で転記が無難でしょうか？
（Lila） 2015/10/20(火) 09:08
はい。数値精査については、一度、ゆっくりと整理して、まとまれば別トピとしてあっぷされたらよろしいかと思います。
で、最後の「前段階」の相談ですが、そもそもが、個人的には、横に項目がたくさんあるレイアウトって、扱いにくいんじゃないかと思っています。 E〜AZ で 48列。β的には、このあたりが、目で見ながら処理をしていく限界だと思うんですが、さらに、それが ７ブロックあるということは336列ですから。 もっとも、各列の列幅は、ぐっと小さくしてあって、あまりスクロールも必要ないのかもしれませんが。
結果シートの品番を、別システムから取り込むということもあって、１枚につめこんであるのかもしれませんけど、aaaaaa と bbbbbb を左右に見比べながら業務を行うという 必要がなければ、最初から aaaaaa シート と bbbbbb シートをわけておいてもいいのではないかと。 見比べる必要があれば、新しいウィンドウをつくって、上下に整列させて、それぞれに見比べるシートを表示してもよさそうですし。
なので、現在の横長のシートを分割して複数シートに仕立て上げるのは、要件さえ明確にしてもらえれば、なんとでもなると思います。 1種類は12列という説明と、E〜AZの48列の関係もよくわかりませんので、そのあたりも明確にしてもらえればいいのですが。
（β） 2015/10/20(火) 09:48
＞ なので、現在の横長のシートを分割して複数シートに仕立て上げるのは、要件さえ明確にしてもらえれば、なんとでもなると思います。
＞ 1種類は12列という説明と、E〜AZの48列の関係もよくわかりませんので、そのあたりも明確にしてもらえればいいのですが。
1種類（「aaaaa」）は12列使用（1年分の数値を転記している為）で、同じ種類（大きさが違ったり、幅が違ったり）のもので構成された7つのくくりが、
＞「E〜AZ」「BA〜BL]「BM〜BX」「BY〜DH」「DI〜FD」「FE〜GB」「GC〜GZ」
になります。
なのでそれぞれ
「E〜AZ」←4種類
「BA〜BL]←1種類
「BM〜BX」←1種類
「BY〜DH」←3種類
「DI〜FD」←4種類
「FE〜GB」←2種類
「GC〜GZ」←2種類
分の情報があるので、それをくくりごとでシートに分けられないかなぁ？という事でした。
それぞれのおおきなくくりでの名前（英数値）で判断･･･と思いましたが、同じ数値でも別のくくりだったり、同じ名称でも数値が違うと別のくくりだったり･･･というのがあるので･･･うーん･･･
そうするとやはり数日前にやろうとしていた事になりますが、1行目か3行目あたりに行追加して、大きなくくりを入力した方が、集めやすいし、今後くくりに種類が増えた時や、もしかしたら移動（同じ種類でも新旧で分かれていたりするため）にも、すぐに対応できるのかな？と思いました。
（Lila） 2015/10/20(火) 10:18
3行目が空白だったので、そこに追加してみました。
＜Sheet1 レイアウト＞
|[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |
[1]|部品ｺｰﾄﾞ|品名|英語品名| | aaaaa | bbbbb |
[2]| | | | |2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|2014/11|2014/12|2015/01|2015/02|2015/03|2015/04|2015/05|2015/06|2015/07|2015/08|2015/09|2015/10|
[3]| | | | | abab
[4]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[5]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
[6]| | | | | | | | | | | | | | | | | | | | | | | | | | | | |
（Lila） 2015/10/21(水) 10:51
あぁ、なんとなくわかりました。
aaaaaa で１シート、bbbbbb で１シートと考えていたんですがそうではなく、 aaaaaaの親戚で１シート、bbbbbb の親戚で１シート。
こういうことですか。
であれば、どれとどれが親戚かを規定しなければいけませんね。 そちらの案のように、親戚をグルーピングする行を設けるのも１案ですし、 どこか別シートに
aaaaaa組 aaaaaa aaaaax aaaaay aaaaaz bbbbbb組 bbbbbb bbbbb1 bbbbb2
といったような紐つけ表を持っておくのも１案でしょうね。
ところで、（Lila） 2015/10/15(木) 16:59 で示された aaaaaa は 24列でした。 で、（Lila） 2015/10/21(水) 10:51 では 12列。 このあたりが、まだβがわかっていないところですが悩んでいます。
何列あろうと、右から12列分を対象にして、シートをわけるということなのかな？とも思ったりしていますが。
（β） 2015/10/21(水) 17:18
＞ aaaaaa で１シート、bbbbbb で１シートと考えていたんですがそうではなく、 aaaaaaの親戚で１シート、bbbbbb の親戚で１シート。
そうです！
そのようなニュアンスが一番近いですね！
＞ところで、（Lila） 2015/10/15(木) 16:59 で示された aaaaaa は 24列でした。
＞ で、（Lila） 2015/10/21(水) 10:51 では 12列。
＞ このあたりが、まだβがわかっていないところですが悩んでいます。
これは、アクセスからデータを取り出した時に、1年と数カ月しか取り出せない（excel側での仕様だそうです）ので、なら、1年単位での運用にしてしまおうと言う事で、どの項目も12列になりました。
なので、「aaaaa」は12列だけど「ccccc」は24列、等という事はなく、どれも「12列」固定になります。
＞ どこか別シートに
＞ aaaaaa組 aaaaaa aaaaax aaaaay aaaaaz
＞ bbbbbb組 bbbbbb bbbbb1 bbbbb2
＞ といったような紐つけ表を持っておくのも１案でしょうね。
なるほど。そういう事も出来るのであれば、その方が追加や削除などの書き込みで面倒が（長いスクロール）少なそうな気がしますね…
（Lila） 2015/10/21(水) 18:32
それでは （Lila） 2015/10/21(水) 10:51 で提示いただいたレイアウトで、３行目のまとめラインがないものを前提に。
このシートを "Sheet1" として、別途、"グループ" という名前のシートを用意してください。（シート名は何でもいいのですが、とりあえず"グループ")
１行目からデータで、A列がグループコード（任意の文字列）、B列から右に、そのグループ内の集計コード（aaaaaa とか bbbbbb とか）を必要な数だけ記述。
分解したものは、グループコードをシート名にしたシートに展開します。 なお、枠はあるけど、集約コードと年月以外が空白のブロックも処理対象にしています。（空白なら対象外ということももちろんできますが）
例によって要件を勘違いしている可能性大なので、間違っていれば指摘願います。
Sub 分割()
Dim fSh As Worksheet
Dim tSh As Worksheet
Dim mCol As Long
Dim mRow As Long
Dim j As Long
Dim x As Long
Dim myCode As String
Dim grpCode As String
Dim grpList As Range
Dim f As Range
Dim dic As Object
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary") 'シート生成辞書
With Sheets("グループ").Range("A1").CurrentRegion
Set grpList = .Offset(, 1).Resize(.Columns.Count - 1)
End With
Set fSh = Sheets("Sheet1") '元シート
With fSh.Range("A1", fSh.UsedRange)
mCol = .Columns.Count
mRow = .Rows.Count
End With
For j = 5 To mCol Step 12 '集約ブロックの先頭列を抽出
myCode = fSh.Cells(1, j).Value '集約コード
Set f = grpList.Find(What:=myCode, LookAt:=xlWhole)
If f Is Nothing Then
MsgBox myCode & " のグループ登録がないので処理をスキップします"
Else
grpCode = f.EntireRow.Cells(1).Value 'グループコード
If Not dic.exists(grpCode) Then
Application.DisplayAlerts = False
If IsObject(Evaluate("'" & grpCode & "'!A1")) Then Sheets(grpCode).Delete
Application.DisplayAlerts = True
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set tSh = ActiveSheet
tSh.Name = grpCode
fSh.Range("A1").Resize(mRow, Columns("P").Column).Copy
'セル幅コピー
tSh.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
tSh.Cells.Clear
fSh.Range("A1").Resize(mRow, 3).Copy tSh.Range("A1")
dic(grpCode) = True
Else
Set tSh = Sheets(grpCode)
End If
With tSh.Range("A1", tSh.UsedRange)
If .Columns.Count < 5 Then
x = 5
Else
x = .Columns.Count + 1
End If
End With
fSh.Cells(1, j).Resize(mRow, 12).Copy tSh.Cells(1, x)
End If
Next
End Sub
（β） 2015/10/21(水) 20:40
おはようございます！
コードありがとうございます。
早速検証してみました。
グループシートを作成し、７つのグループコード（A列）とそれぞれの集計コード（B列〜）を入力し、実行してみました。
結果は、4行目までは成功したのですが、5行目からが「グループ登録がないので、処理をスキップします」と出てしまい、現在入力のある5行目〜7行目は出力されませんでした。
グループシートを手入力だったので、そのせいかもしれないと、作業シート（Sheet1）からコピーして貼り付けてからもう一度実行してみたのですが、結果は同じでした。
＞ なお、枠はあるけど、集約コードと年月以外が空白のブロックも処理対象にしています。（空白なら対象外ということももちろんできますが）
集約シートは、数値のある所だけが見たいので、対象外という処理が欲しいと思います。
コードを調べてみたのですが「 If cell.Value <> "" Then 」とかでしょうか･･･？
（Lila） 2015/10/22(木) 08:59
>>結果は、4行目までは成功したのですが、5行目からが「グループ登録がないので、処理をスキップします」と出てしまい、現在入力のある5行目〜7行目は出力されませんでした。
う〜ん・・・ロジック上はそういうことにはならないはずなんですがねぇ。 Sheet1の1行目の集約コードがグループシートの B列以降に記入された集約コードと異なるということしか考えられません。 どのシートのどのセルでもいいですが反映されなかった集約コードに関して、グループシートのそのセル=Sheet1のそのセル といった数式を入れて TrueとでるかFalseとでるか確認してもらえますか？
で、からっぽのものは対象から外すコード。２行追加すればいいのですが、フルセット。（★を追加）
Sub 分割2()
Dim fSh As Worksheet
Dim tSh As Worksheet
Dim mCol As Long
Dim mRow As Long
Dim j As Long
Dim x As Long
Dim myCode As String
Dim grpCode As String
Dim grpList As Range
Dim f As Range
Dim dic As Object
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary") 'シート生成辞書
With Sheets("グループ").Range("A1").CurrentRegion
Set grpList = .Offset(, 1).Resize(.Columns.Count - 1)
End With
Set fSh = Sheets("Sheet1") '元シート
With fSh.Range("A1", fSh.UsedRange)
mCol = .Columns.Count
mRow = .Rows.Count
End With
For j = 5 To mCol Step 12 '集約ブロックの先頭列を抽出
myCode = fSh.Cells(1, j).Value '集約コード
Set f = grpList.Find(What:=myCode, LookAt:=xlWhole)
If f Is Nothing Then
MsgBox myCode & " のグループ登録がないので処理をスキップします"
Else
If WorksheetFunction.CountA(fSh.Cells(3, j).Resize(mRow - 2, 12)) > 0 Then '★
grpCode = f.EntireRow.Cells(1).Value 'グループコード
If Not dic.exists(grpCode) Then
Application.DisplayAlerts = False
If IsObject(Evaluate("'" & grpCode & "'!A1")) Then Sheets(grpCode).Delete
Application.DisplayAlerts = True
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set tSh = ActiveSheet
tSh.Name = grpCode
fSh.Range("A1").Resize(mRow, Columns("P").Column).Copy
'セル幅コピー
tSh.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
tSh.Cells.Clear
fSh.Range("A1").Resize(mRow, 3).Copy tSh.Range("A1")
dic(grpCode) = True
Else
Set tSh = Sheets(grpCode)
End If
With tSh.Range("A1", tSh.UsedRange)
If .Columns.Count < 5 Then
x = 5
Else
x = .Columns.Count + 1
End If
End With
fSh.Cells(1, j).Resize(mRow, 12).Copy tSh.Cells(1, x)
End If '★
End If
Next
End Sub
（β） 2015/10/22(木) 09:07
グループリストの登録ですけど、１行目から空白行なく、ずらっと上に詰めて記載してもらっていますか？ たとえば１〜４行目に記載し、５行目を空白行にして、６行目から、また記載 ということだと、アップしたコードでは ４行目までしかみにいっていないので、そうなりますけど？
（β） 2015/10/22(木) 09:11
＞ どのシートのどのセルでもいいですが反映されなかった集約コードに関して、グループシートのそのセル=Sheet1のそのセル といった数式を入れて
＞ TrueとでるかFalseとでるか確認してもらえますか？
シートわけできなかった、８つのデータについて上記数式で確認してみましたが、全て「True」でした。
＞ グループリストの登録ですけど、１行目から空白行なく、ずらっと上に詰めて記載してもらっていますか？
＞ たとえば１〜４行目に記載し、５行目を空白行にして、６行目から、また記載 ということだと、アップしたコードでは４行目までしかみにいっていないので、そうなりますけど？
はい、空白等は入れずに、A1〜A7にグループコード、B列〜現在は最大でE列までのデータコード（Sheet1での1行目の項目と同じもの）を入力してあります。
修正コード、ありがとうございます！
コード書き換え後、もう一度検証してみます。
また以前のときのように、何処かでおかしくなっている可能性もありますかね？
（Lila） 2015/10/22(木) 09:28
実行してみたのですが、やはりグループシート5行目から下３つで「グループ登録が〜」と出てしまいますね･･･。
追加していただいた空白コードについての質問なのですが"データが空白の時はデータを転記しない"というコードなのでしょうか？
それとも、"データが空白の時は部品コードからデータまで全て転記しない"というコードなのでしょうか？
（Lila） 2015/10/22(木) 09:35
ごめんなさ〜い！！！
Set grpList = .Offset(, 1).Resize(.Columns.Count - 1)
この、おばかなコードを
Set grpList = .Offset(, 1).Resize(.Rows.Count - 1)
にかえてください。（汗、汗）
>>追加していただいた空白コードについての質問なのですが"データが空白の時はデータを転記しない"というコードなのでしょうか？ >>それとも、"データが空白の時は部品コードからデータまで全て転記しない"というコードなのでしょうか？
考え方としては、そのブロックが、元々 Sheet1 になかったという扱いになります。 ですから、当該のグループに、この集約コードブロックしかなかった場合は、そのグループコード用のシートは作成されません。 当該のグループに、マッチした集約コードがあれば、それをベースにしたグループコードのシートが作られますから 当然、部品コード他も転記されますね。
発想というか考え方をかえて、グループシートで指定されたA列グループコード用のシートを すべて作成する。 で、それにマッチした集約コードブロックを、それぞれに転記していく。 結果、グループシートに登録のないSheet1のブロックは無視されますが、グループシートに登録されたグループコードについては、 Ａ〜Ｃ列のみのからっぽのシートになる。
こういったことはできますけど。
（β） 2015/10/22(木) 09:55
＞ 考え方としては、そのブロックが、元々 Sheet1 になかったという扱いになります。
＞ ですから、当該のグループに、この集約コードブロックしかなかった場合は、そのグループコード用のシートは作成されません。
＞ 当該のグループに、マッチした集約コードがあれば、それをベースにしたグループコードのシートが作られますから当然、部品コード他も転記されますね。
あ、ええと、はい。タブが作成されないということで、そこは恐らくそうなのだろうなとわかったのですが、お聞きしたかったのは、タブが作成された方の事で、
＞（空白なら対象外ということももちろんできますが）
こちらの意味としては作成されたタブに転記した例えば「aaaaa」のうちの
・データの入った箇所のみ、部品コードと共に転記
・部品はすべて転記されるけど、データの空白部は転記していない（見た目には全て転記していた時と変わらない）
という事のどちらなのでしょうか？という質問でした。
（頂いたコードで書き換えなおして実行した所、それぞれのタブで、部品コードが全て転記されているように見えたからの質問でした）
ところで、「 Set grpList = .Offset(, 1).Resize(.Rows.Count - 1) 」こちらのコードに書き換えた所、6行目までが動き、タブ作成と転記が出来ていました！
ですが、最後の7行目で再びの「グループが登録されていないので〜」が発動してしまいました･･･。
（Lila） 2015/10/22(木) 10:12
またまた、あわてておばかな連絡をしてしまいました。
Set grpList = .Offset(, 1).Resize(.Rows.Count - 1)
これを
Set grpList = .Offset(, 1).Resize(,.Columns.Count-1)
にして試してください。
反映は12列単位で実行します。 なので、12列領域の数値欄がすべて空白なら無視（転記対象外） 1セルでも値があれば、その12列のブロックをすべて（列によっては空白列もあるかもしれませんが）転記。 また、行は、その部品があろうとなかろうとすべて転記します。 なので、行によっては空白の行もあります。でも、左側の部品コードは記載されています。
こういうことです。 わかりにくいですかね？
（β） 2015/10/22(木) 10:25
タブ作成から転記までうまく行きました！
ありがとうございます！
＞ 反映は12列単位で実行します。
＞ なので、12列領域の数値欄がすべて空白なら無視（転記対象外）
＞ 1セルでも値があれば、その12列のブロックをすべて（列によっては空白列もあるかもしれませんが）転記。
これは大項目「aaaaa」と12か月の年月やデータ行に数値が入っていれば転記（「aaaaa」や年月はあって、データ行は空白だがそれも転記）という意味で間違いないですか？
＞ また、行は、その部品があろうとなかろうとすべて転記します。
＞ なので、行によっては空白の行もあります。でも、左側の部品コードは記載されています。
解りました。
ありがとうございます！
データの入っていない部品コードやらは、手作業で削除することにします。
（Lila） 2015/10/22(木) 10:36
>>これは大項目「aaaaa」と12か月の年月やデータ行に数値が入っていれば転記（「aaaaa」や年月はあって、データ行は空白だがそれも転記）という意味で間違いないですか？
はい、そうです。
>>データの入っていない部品コードやらは、手作業で削除することにします。
マクロ内で行うのは全然むずかしくないですよ。必要なら。
要は、たとえば、部品コードが A,B,C,D,E と 4つあった。 で、おなじグループの aaaaaa は A,C,E に値があった。bbbbbb は B,E に値があった。 でも、aaaaaaを転記する際に、ないものをつめて A,C,Eとしてしまうと、同じシートにbbbbbbを転記するときに 困ってしまいますね。B を記載する行が必要なので。 行挿入という手もありますし、ない場合は部品の最後に追加するということもできますが、それだとコードも煩雑になりますし 特に、最後に追加するとなると、データによって部品の順番がかわってくるわけで、管理もしづらい？
ですから、やるとすれば、処理の最後に、各シートを取り出して、１行フルに空白の行は消す。 こうするのが簡単です。 仮に、列についても、空白の日付列は不要であれば、同じタイミングで処理することもできます。
必要ならいってください。
（β） 2015/10/22(木) 12:39
＞ 要は、たとえば、部品コードが A,B,C,D,E と 4つあった。
＞ で、おなじグループの aaaaaa は A,C,E に値があった。bbbbbb は B,E に値があった。
＞ でも、aaaaaaを転記する際に、ないものをつめて A,C,Eとしてしまうと、同じシートにbbbbbbを転記するときに
＞ 困ってしまいますね。B を記載する行が必要なので。
＞ 行挿入という手もありますし、ない場合は部品の最後に追加するということもできますが、それだとコードも煩雑になりますし
＞ 特に、最後に追加するとなると、データによって部品の順番がかわってくるわけで、管理もしづらい？
これはつまり、「aaaaa」、「bbbbb」、「ccc」と順番に処理していく中で、こっちにはあったけど、こっちにはなかった部品コードを記載する場所がない場合があるので、と言うことですか？
＞ ですから、やるとすれば、処理の最後に、各シートを取り出して、１行フルに空白の行は消す。
＞ こうするのが簡単です。
＞ 仮に、列についても、空白の日付列は不要であれば、同じタイミングで処理することもできます。
確かに、最初のものより、こちらの方が簡単なイメージを持ちますね！
なぜ、数値のない部品行を削除したいのかと言うと、シートが1つの時は、部品がいくつあってもシートが1枚だったのでそこまで重くなかったのですが、これを７つに転記したことによって、少なくとも部品コードだけでも同じ行数（1万5千以上）が8シート分もあるので、凄く重くなってしまいます･･･。
大抵がノートPCを使用しているので、容量はなるべく抑えたいというのが目的なのです。
出来れば、こちらもご教示頂けると大変助かります･･･
（Lila） 2015/10/22(木) 13:01
それでは、
Dim shn As Variant
Dim r As Range
Dim d As Range
これら宣言を追加し、End Sub の上に
'空白行の削除
For Each shn In dic
With Sheets(shn).UsedRange
Set d = Nothing
For Each r In .Offset(4, 4).Resize(.Rows.Count - 4, .Columns.Count - 4).Rows
If WorksheetFunction.CountA(r) = 0 Then
If d Is Nothing Then
Set d = r
Else
Set d = Union(d, r)
End If
End If
Next
If Not d Is Nothing Then d.EntireRow.Delete
End With
Next
なお、部品品番行は４行目からとしています。
（β） 2015/10/22(木) 13:42
βさん、ありがとうございます！
ばっちり成功しました^o^！！！
＞ なお、部品品番行は４行目からとしています。
ここで、4行目というと、フィルターを入れたくて、とって置いてもらっている箇所なので、この行も消えてしまうのかな？と思ったのですが、そのままだったので、ここは何故空白のままなのですか？？
部品コードが無い（そもそもA列に値がない）から、という事ですか？
（Lila） 2015/10/22(木) 13:52
あっ、ごめん。５行目から品番というコードです。 コメントが間違ってました。
いずれにしても、ほっとしてます。
（β） 2015/10/22(木) 15:22
なるほどです^o^
今回も、大変助かりました！
以前の、グラフの方は、また別にスレッドを建てさせていただこうと思います。
本当に、ありがとうございました。
（Lila） 2015/10/22(木) 15:34
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.