Results of 1 - 1 of about 78 for 表示形式 数値 通貨 (0.011 sec.)
表示形式 (6901), 数値 (16333), 通貨 (231)
- [[20151022153817]]
- #score: 11548
- @digest: aa097dac4f68af0bad51fbe91cd67481
- @id: 69150
- @mdate: 2016-03-03T23:48:21Z
- @size: 92007
- @type: text/plain
- #keywords: 約コ (162669), scoperange (112750), lila (102495), adrremain (79719), 故障 (72238), yyyymm (42973), (li (37217), 部品 (36827), 集約 (33564), 分割 (19107), 2015 (16049), シジ (14570), ブッ (10909), value (9507), ロシ (9230), 処理 (9006), コー (8891), グル (8330), range (8037), ック (7153), (β (7076), ード (6978), レイ (6419), ジャ (6417), cells (6390), シー (6278), イア (5844), モジ (5692), アウ (5573), sheets (5447), ジュ (5441), ウト (5385)
- 『別ブックを複数使用した部品交換率の表』(Lila)
こんにちは、今回もよろしくご教示頂ければと思います。 [[20151015154911]] こちらの続き的なものになるのですが、 部品の交換率での異常を見る表を作成したいのです。 前回の完成品(グループごとにタブ分けされた、故障部品の数値)から前々回の完成品(商品1つに対する使用部品数一覧)と稼働台数の書いてあるそれぞれ3つのブックを使用して【 故障部品/使用数*稼働台数 】という計算をして、シートに部品コード、品名、英語品名と共に計算結果を記載したいです。 ・【故障部品/使用数*稼働台数】はその月の数値が入った場所に対して計算します ・【故障部品/使用数*稼働台数】は最新月から遡って半年分計算します それぞれの部品数は現在、一番多いものでも205行(データ行のみ。全部あわせてなら209行)です。 転記部分はVBA、計算部分は関数の方が良いのかなと思うのですが(データ部分に、この月はデータがあるけれど、次の月はデータがないという事があるため)、複雑な関数は良く判りません・・・ やはり、どちらかの方が、処理が軽くて早いでしょうか? ご教示頂けると大変助かります。 よろしくお願いします。 (尚、当方算数数学がからっきしなので、途中の計算式も間違い等ありましたらすみません;) < 使用 Excel:Excel2013、使用 OS:Windows7 > ---- 前回のレイアウト、前々回のレイアウトといっても、それぞれに、いくつかのサマリー表もつくりましたし また、β以外の回答者さんたちにとっては、どんなレイアウトなのか皆目わかりませんね。 このレイアウトとこのレイアウトという具体例のサンプルを例のユーティリティを使ってアップすれば ほかの方々からのアドバイスも期待できますね。もちろん、私も考えてはみますが。 (β) 2015/10/22(木) 19:02 ---- すいません。 編集中に別の事をやっていたら、そのままになってしまっていました; ・グループごとにタブ分けレイアウトは、1種類(下記例のもの)〜最大4種類まで、1種類それぞれ12列で記載されています。 ・商品ひとつひとつに対する使用部品数一覧は「大項目>中項目>小項目>形状」の4層に分かれており、それら全てを網羅するもの、中項目までしかないもの、小項目までしかないもの、大項目のみのものも含まれています。 <グループごとにタブ分けレイアウト> |[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| 稼働台数のレイアウトはまだ取っていないので、取得次第編集させて頂きます。 (Lila) 2015/10/23(金) 08:40 使用レイアウト変更のため削除 ---- 商品ひとつひとつに対する使用部品数一覧 ですけど、このレイアウトを相手にするより、 [[20151015154911]] 『月ごとの使用数を転記したい。』(Lila) の、(β) 2015/10/19(月) 16:36 で提示した、大項目・中項目で集約したものを使ったほうが 処理しやすいと思いますが? (β) 2015/10/23(金) 09:22 ---- >βさん 確かに、そうですね! そちらはまだレイアウトを取得していなかったので、すぐに取得して、編集させて頂きます。 <稼働台数レイアウト> |[A] |[B] |[C] [1]|設定月 |集計区分 |稼働台数 [2]|2015/10/01|aaaaa | 11 [3]|2015/10/01|ddsddd | 58 [4]|2015/10/01|ccsdd | 46 [5]|2015/10/01|bbbbbbb | 133 [6]|2015/10/01|abcde | 19 <商品ひとつひとつに対する使用部品数一覧レイアウト> |[A] |[B] |[C] |[D] |[E] |[F] [1]| |Ebddd|TTTaa|cdxxx |aaaaa|bbbbb [2]| | | | | | [3]|MP-*EMC-13HK-3D| | | | | [4]|MP-*IP085C-SDM5| | | | | [5]|MP-*M201400 | | | | | [6]|MP-00021182 | | | | | [7]|MP-00021205 | | | | | [8]|MP-00030687 | | | | | [9]|MP-00880152 | | | | 8| 8 <結果イメージレイアウト> |[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| (Lila) 2015/10/23(金) 09:33 使用レイアウト変更後のものを追加 10:41 ---- 3つのブック(シート)が登場するので、仮に 商品ごとの使用部品数一覧(これは、再掲された集約版) をAブック(Aシート) 故障部品数リスト をBブック(Bシート) 稼働台数表を Cブック(Cシート) としてコメントします。 いくつか確認。 1.Bブックですが、直近12か月がすでに記載されているのですね? なので、12列の中の後半の6列に対して分析を行うということでいいのですか? 2.Cブック。1つの集計区分で同じ月のものが複数登場することはないですね? 3.計算結果は 故障数/使用総数 ですから 割合ですよね。つまり % で表示するのですね? 4.で、これた3つから作り出される表のレイアウトって、自由に考えていいのですか? 5.また、今回の処理、3つのブックのうち、いずれが、マクロブックになりますか? (β) 2015/10/23(金) 13:44 ---- > 1.Bブックですが、直近12か月がすでに記載されているのですね? > なので、12列の中の後半の6列に対して分析を行うということでいいのですか? はい。そうです。 前回([[20151015154911]] )のタブ分けされた7つのシートを元としての方が組みやすいのか、それとも分ける前の1つのシートに纏まっている方が組みやすいのがでまたコードも変わると思いますが、どちらの場合でも「数値、直近12ヶ月の年月」は入力されている状態ではあります。 > 2.Cブック。1つの集計区分で同じ月のものが複数登場することはないですね? これは、あります。 なぜかと言うと、同じもの例えば「aaaaa」には「aaa-300」「aaa-500」「aaa-1800」等という型は同じだけど、大きさや幅などが違うシリーズものが含まれている為です。 ただ、もう古過ぎたり、海外専用などのものが多数なので、そこは複数あっても大丈夫(表に記載する予定がないので)なのかなと。 (もちろん、データを記載しなければいけない場合も出てくるかもしれませんが・・・) > 3.計算結果は 故障数/使用総数 ですから 割合ですよね。つまり % で表示するのですね? そうですね。 最終的には「%」を入れて表示する予定です。 > 4.で、これた3つから作り出される表のレイアウトって、自由に考えていいのですか? えと、イメージは上記に載せたのですが、「A」「B」「C」列が「部品コード」「品名」「英語品名」になっており、どの商品の直近12ヶ月の部品故障率はこう! というのがわかる様になれば、問題ありません。 > 5.また、今回の処理、3つのブックのうち、いずれが、マクロブックになりますか? 今回の処理は「Bブック」をマクロブックにしようと考えています。 (Lila) 2015/10/23(金) 14:22 ---- >>タブ分けされた7つのシートを元としての方が組みやすいのか、それとも分ける前の1つのシートに纏まっている方が組みやすいのが あぁ、そうですね。分ける前のほうがシートのループがなくなるので、素直なコードになるでしょうね。 >>集計区分で同じ月のものが複数登場 <-- これはあります。 了解です。合計します。 >>レイアウト 掲示されたのは12か月が掲載。要件説明では 6か月とあったので? >>「Bブック」をマクロブック 了解です。 (β) 2015/10/23(金) 14:34 ---- > あぁ、そうですね。分ける前のほうがシートのループがなくなるので、素直なコードになるでしょうね。 先日頂いたコードをシート名などを変更すれば、そこからグループ分けが可能になりますかね? > >>レイアウト > 掲示されたのは12か月が掲載。要件説明では 6か月とあったので? ああ・・・すいません。確かにそうですね; 6ヶ月で大丈夫です。 レイアウトも、12列の半分の6列になります! (Lila) 2015/10/23(金) 15:13 ---- かなり手抜きというか決め打ちのコードです。 かつ、稼働確認(動くということ)はしましたが結果の検証は全くしていないのでよろしくお願いします。 関連のブックをマクロ内で開いて参照して閉じるということも、もちろんできますが、とりあえずは 実行時に マクロブック(故障部品数ブック Bブック)のほかに、商品別部品使用数ブック(Aブック)、稼働台数ブック(Cブック)は 開かれているというところからのコードになっています。 またAブックは集約版のシートを使います。またマクロブック(Bブック)は、グループコード別分解シートではなく、元のすべてが入ったシートをあいてにします。 Bブックの各集約コード別列数は12列と決め打ちしています。(マクロで列数を自動把握もできますが、していません) かつ、このシートを新規ブックとしてコピーして、それに対して処理を行います。 処理後も、保存せず、とりあえず、そのまま新規ブックとしてエクセル上に残っています。 ブック名、シート名等は コードの先頭のほうで規定していますので実際のものに直してください。 Sub 故障率() Dim shA As Worksheet Dim shB As Worksheet Dim shC As Worksheet Dim c As Range Dim dicA As Object Dim dicC As Object Dim k As Variant Dim mCol As Long Dim mRow As Long Dim j As Long Dim sv As String Dim parts As String Dim yyyymm As String Dim n As Long Application.ScreenUpdating = False ThisWorkbook.Sheets("Sheet1").Copy '故障部品 Set shB = ActiveWorkbook.Sheets(1) Set shA = Workbooks("Aブック.xlsm").Sheets("Sheet2") '商品別部品使用数(集約表) Set shC = Workbooks("Cブック.xlsx").Sheets("Sheet1") '稼働台数 Set dicA = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") For Each c In shC.Range("A2", shC.Range("A" & Rows.Count).End(xlUp)) k = Format(c.Value, "yyyymm") & c.Offset(, 1).Value '年月+集約コード dicC(k) = dicC(k) + c.Offset(, 2).Value '稼働台数 Next With shA.Range("A1", shA.UsedRange) With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1) For Each c In .Cells k = c.EntireRow.Cells(1).Value & vbTab & c.EntireColumn.Cells(1).Value '部品番号+集約コード dicA(k) = dicA(k) + c.Value '集約コード内部品数 Next End With End With With shB With .UsedRange mCol = .Columns.Count mRow = .Rows.Count End With For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 sv = .Cells(1, j).Value '集約コード .Columns(j).Resize(, 6).Delete .Cells(1, j).Value = sv With .Range(.Cells(5, j), .Cells(mRow, j + 5)) For Each c In .Cells parts = c.EntireRow.Cells(1).Value yyyymm = Format(c.EntireColumn.Cells(3).Value, "yyyymm") n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) If n = 0 Then c.Value = "#DIV/0!" Else c.Value = c.Value / n End If Next .NumberFormatLocal = "0.00%" End With Next End With End Sub (β) 2015/10/23(金) 22:11 ---- βさん、いつもありがとうございます。 月曜に検証してみます! (Lila) 2015/10/24(土) 06:50 ---- βさん、おはようございます。 検証前に、以前頂いた集約コードでエラーが発生してしまい、依然検証できていません。 >[[20151015154911]] 『月ごとの使用数を転記したい。』(Lila) > の、(β) 2015/10/19(月) 16:36 で提示した、大項目・中項目で集約したものを使ったほうが こちらの集約コードなのですが、頂いたときに動作確認し、シート2に結果も出たのですが、今↑のコードの検証前に、データを新しくしようとマクロを走らせたら、コード下のほうの >vntT(y, x) = vntT(y, x) + c.Value '集約表配列に足し込み で「エラー13 型が一致しません」が発生してしまい、宣言のところで他の型にしてみると、今度は「コンパイルエラー 配列がありません」で >ReDim vntT(1 To nRows, 1 To dicX.Count) '集計表領域サイズの配列 ここの >ReDim vntT(1 To nRows, 1 To この部分が青くなってしまいました。 型は元は「Variant」になっていて、「Long」「String」「Range」「Object」を試してみましたが、どれも配列がありませんのコンパイルエラーになってしまいます。 大項目〜形状の箇所を少しいじった(列削除や挿入、入力)くらいしか、以前の検証時と変わりは無いのですが・・・ (Lila) 2015/10/26(月) 09:24 ---- こんにちは。 不思議ですね。 Lilaさん案件のもろもろのブック、こちらで、同じフォルダに入れてあるのですが、要件変更にあたって 少しずつコードを変えたりしていて、マクロブックのバージョンが異なるものが、いくつもあって どれが、最新か、自分自身でも迷ったりしていますが、きっと、このコードが最新だろうというもので AブックのSHeet1,SHeet2ができている状態から、使用量集計を走らせても、問題なく Sheet2が再作成されます。 vntT(y, x) = vntT(y, x) + c.Value '集約表配列に足し込み ここでエラーになった時点で、マウスを vntT(y, x) や c.Value の上に充てると、どんな値がポップアップされますか? もし、c.Value が数値ではなかったら、 ・Ctrl/g で イミディエイトウインドウを表示させ、そこに ?c.Address とタイプしてエンター。 そこに出てくるセルアドレスの場所がどうなっているか、確かめてもらえますか? ★今、久しぶりの風邪でダウン中。対応が遅れるかもしれませんがご容赦ください。 (β) 2015/10/26(月) 12:31 ---- >vntT(y, x) ここには、数値で "3 6" の値が入っていました。 >c.Value こちらは 「=4」の値でした。 こちらは、Sheet2を作成した状態(何も入力されていない状態)でマクロを走らせました。 > ・Ctrl/g で イミディエイトウインドウを表示させ、そこに ?c.Address とタイプしてエンター。 > そこに出てくるセルアドレスの場所がどうなっているか、確かめてもらえますか? こちら、一応数値ではありましたが念のため確認して「$X$275」と出ましたので、そのセル値を確認しました所、「4」だったので問題はなさそうに見えますが・・・ 丁度この「W」「X」「Y」列で変更作業をしたので、その影響?とも・・・ (変更前は「W〜Y」の1行目2行目がそれぞれ結合セルでしたが、よくよく数値を持ってくるデータシートを見ましたら、「W」列と「X」列で1シート、「Y」列で1シートになっていた為、同じ英数字を「大項目〜中項目」で使用していますが、別列に分けました。) > ★今、久しぶりの風邪でダウン中。対応が遅れるかもしれませんがご容赦ください。 風邪つらいですね>< 暖かくして水分を摂りゆっくり寝てください! 今年の風邪は、咳が残る風邪のようですので、のど飴も忘れずに・・・>< お大事にしてくださいね・・・! (Lila) 2015/10/26(月) 13:07 ---- >>>vntT(y, x) >>ここには、数値で "3 6" の値が入っていました。 x や y ではなく、マウスを vntT にあてて、vntT(t,x) そのものの値を見ていただけますか? 想像ですけど、数値ではないものが入っているのでは? で、なぜ数値ではないものが入ったか。 気力が回復したら、ここについても説明しますが、今は、ちょっとサボらせてください。 いずれにしても、いま、集約しようとしている、vntT(y,x) に相当するデータの空白以外の最初のデータが 数値ではなく、何か変なものが入っているということだろうと思います。 SHeet1 の F1から、このリストの一番右下のセルまで選択して ホームタブ、右のほうの検索と選択、条件を選択してジャンプ ここで定数 を選び、数値のチェックをはずしてOKをおすと 何か選択されませんか?(シートのセルが正しい内容であれば、ここでは何も選択されないはずです) (β) 2015/10/26(月) 16:57 ---- > >>>vntT(y, x) > >>ここには、数値で "3 6" の値が入っていました。 > x や y ではなく、マウスを vntT にあてて、vntT(t,x) そのものの値を見ていただけますか? > 想像ですけど、数値ではないものが入っているのでは? vntT(y,x) = "3 6" が入っています。 「y」と「x」にはまた別の数値が入っているようです。(y = 271 , x = 7) > で、なぜ数値ではないものが入ったか。 > 気力が回復したら、ここについても説明しますが、今は、ちょっとサボらせてください。 はい、お元気になってからで構いませんので、解説よろしくお願いします>< > SHeet1 の F1から、このリストの一番右下のセルまで選択して > ホームタブ、右のほうの検索と選択、条件を選択してジャンプ ここで定数 を選び、数値のチェックをはずしてOKをおすと > 何か選択されませんか?(シートのセルが正しい内容であれば、ここでは何も選択されないはずです) F1〜BF4までの大項目〜形状の数値ではない部分と、データ部分の文字列のものに(例えば「2m」等の)が選択されている状態になりました。 (Lila) 2015/10/26(月) 17:10 ---- ぼぉっとしてましたね。 F1 からではなく F5 から、つまり 数値データが 入っているところの領域を選択して やってみてください。 今回のもの、 "3 6" 、これが犯人ですが、それ以外にもあるかもしれません。 それらを正しい値に打ち直してリトライ願います。 ところで、データ部分の文字列のものに(例えば「2m」等の)・・・ これが気になっています。コードは、この領域は 数値ないしは空白だと考えています。 "3 6" でも、だめですが、"2m" でも だめです。 ただ、各人の長年の習慣で、もう 2m は、だめとはいえないということなら、手はあります。 でも、この集約表作成だけではなく、今までの他の機能にもすべて、その手をいれなければ不統一になりますねぇ。 で、2m 等は救えたとしても "3 6" は救えないですね。(これは、3 扱いになります) (β) 2015/10/26(月) 17:27 ---- 今回の障害の原因(と思われる)に関する参考コードです。 Sub ExcelVBAの小さな親切大きなお世話() Dim n As Variant n = n + "3 6" '<==犯人はここなのに ' ' ' 様々な処理 ' ' n = n + 4 '事件が発覚した時点では犯人は逃亡済み End Sub (β) 2015/10/26(月) 17:44 ---- > ところで、データ部分の文字列のものに(例えば「2m」等の)・・・ > これが気になっています。コードは、この領域は 数値ないしは空白だと考えています。 > "3 6" でも、だめですが、"2m" でも だめです。 > ただ、各人の長年の習慣で、もう 2m は、だめとはいえないということなら、手はあります。 > でも、この集約表作成だけではなく、今までの他の機能にもすべて、その手をいれなければ不統一になりますねぇ。 > で、2m 等は救えたとしても "3 6" は救えないですね。(これは、3 扱いになります) 取り込むデータシートを見ているとたまに "3 6"こういったものがあり、これは前はこっちの数値を使用していたけれどいまはこっちという風に片方は取り消し線で消されていたりするものの修正見落としですね…すみません。 「2m」やその他文字列( "3 6"こういうものは、私が元データをコツコツ直すしかありませんが)は処理せずに飛ばす(恐らく今回必要な故障部品というものには含まれないものばかりなので。セロテープ的なものや、チューブなどの消耗品に含まれるものかと)というコードにしてみようと思います。 確か以前頂いたコードにそのような処理があったと思うので! (Lila) 2015/10/26(月) 18:31 ---- >>私が元データをコツコツ直すしかありませんが "3 6" 含めて、文字列を読み飛ばすことはできます。 できますが、そうしないほうがいいと思います。 入力した人は、「正しく」2m や 3 6 と入れたつもり。 これを コードで スキップすると、結果として正しくない集計結果が作られ、しかもだれも気付かない。 この集計結果で何かを判断して、次の工程にいかしていくのでしょうから、それは具合わるいと思います。 といって こつこつ も大変でしょうね。 そもそもが、大本は、前回の結果ブックを作成するときに参照しているデータブックですよね。 ですから、データ取り込み の最初のほうで、領域 r1,r2,r3 に対してエラー値の存在有無をチェックしているところがありますが このあたりで、r3(データ領域) に対して、数式または定数で、論理値+文字列 があるかどうか、あれば スキップ というロジックを追加して、大本をたっておくということが必要だと思います。 で、その際に、どのセルが悪かったのかを表示するということもできるかと思いますので。 (β) 2015/10/27(火) 15:06 ---- データシートで、「3 6」というのは、以前は「3」つ又は「6」つ(これも入力する人で違うのが問題なのですが)使用していたけれど、Verアップで「6」つ又は「3」つの使用量になりましたというもので、目視だとわかりやすいのですが、どちらかに取り消し線が引かれています。 なので、必ずどちらかで大丈夫な数値なのです。(そしてそれは「故障」の方で上がってくる可能性のあるものも含まれているので、こちらは修正の必要がありました。ので、今日は朝から格闘していました・・・) 「2m」などの文字列として入力されているのものは、消耗品なので、その場合は交換しても「故障」の方では上がってこない部分なので、まとめ用のSheet1にさえあれば問題ないかなと思っています。 一番最初に頂いたデータシートから結果シートへ転記する、というコードでは、確か「文字列でも数値でも関係なく転記する」という説明を頂いたかと思います。 > そもそもが、大本は、前回の結果ブックを作成するときに参照しているデータブックですよね。 > ですから、データ取り込み の最初のほうで、領域 r1,r2,r3 に対してエラー値の存在有無をチェックしているところがありますが > このあたりで、r3(データ領域) に対して、数式または定数で、論理値+文字列 があるかどうか、あれば > スキップ というロジックを追加して、大本をたっておくということが必要だと思います。 これは、そもそも「3 6」や「2m」等の文字列になってしまっている物は転記しない、という命令という事ですか? それとも「3 6」なら「3」、「2m」なら「2」だけを転記するという命令ですか? (Lila) 2015/10/27(火) 15:45 ---- 「3 6」や「2⇒4」のようなものを修正してみたら、見事Sheet2に集約できました! 不思議なことに「2m」や「0.0058m」などは振り分けられていました。 間にスペースや記号があった事が問題だったのでしょうか・・・??? これから、故障部品のコード検証をして行きますので、そちらの結果報告は、後ほどさせて頂きます。 (Lila) 2015/10/27(火) 16:25 ---- 故障率のコードを実行してみましたが、恐らく、途中までは正常に動いていたのかな?と思われますが、やはり「m」はどうにかしないといけませんね・・・ > n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) ここで、型が不一致のエラーがでたのですが、入っていた値が「0.25m」だったので・・・ (Lila) 2015/10/27(火) 16:35 ---- >>不思議なことに「2m」や「0.0058m」などは振り分けられていました これは、「たまたま」です。「たまたま」の状況であれば "3 6" も振り分けができます。 もともと、この "3 6" は、前回の結果シートに、元データブックから取り込んだものですよね。 その時は、エラーになっていなかったわけです。 (β) 2015/10/26(月) 17:44 で、参考コードをアップしていますが、n = n + "3 6" ではエラーになりませんよね。 つまり、Variant型変数(セルも、同じなんですが)に "3 6" を【加算】できた?? 参考コードのプロシジャ名にかいた【小さな親切おおきなおせわ】が、ここで働きます。 もう1つ、参考コード。 Sub test1() MsgBox "ABC" + "XYZ" End Sub Sub test2() MsgBox "ABC" + 10 End Sub Sub test3() MsgBox 10 + "XYZ" End Sub Sub test4() MsgBox 10 + 10 End Sub この【加算】、エラーにはなるものと、ならないものがありますね。 + という演算子、ふつうは 加算だと認識しますが、エクセルにとっては 「加算」ないしは【連結】です。 で、+ される側、ないしは+する側が 数値の場合に 加算、そうでなければ連結( & ですね)されます。 ですから、当該マス目への最初のデータは、文字列であれ数値であれ、格納され、同じマス目に対して次のデータが あった場合に、マス目の値、ないしは加算しようとしている値によってエラーが発生したりしなかったりするわけです。 ★基本的には、今回のコードに手を入れるのではなく 1)前回の結果シートに取り込んだ後、「コツコツ」と、修正。 2)前回のコードで、このチェックを行い、おかしなところがあれば、そのおかしなセルがどこかを表示した上で取り込みスキップ。 いずれかでしょうね。 (β) 2015/10/27(火) 17:24 ---- > これは、「たまたま」です。「たまたま」の状況であれば "3 6" も振り分けができます。 > もともと、この "3 6" は、前回の結果シートに、元データブックから取り込んだものですよね。 > その時は、エラーになっていなかったわけです。 なるほど…ひっかかってしまう時もあれば、通ってしまう時もあるわけですね。 今回はすんなりできたけれど、また次回振り分けてみたらエラーになると言う事も十分に考えられる事ですね。 > 1)前回の結果シートに取り込んだ後、「コツコツ」と、修正。 > 2)前回のコードで、このチェックを行い、おかしなところがあれば、そのおかしなセルがどこかを表示した上で取り込みスキップ。 そうですね。 暫くは、データをコツコツ修正していく事にします>< (Lila) 2015/10/27(火) 18:26 ---- コツコツも大変かもしれません。 ロジックとしては、前回の結果シート作成の一部分を抜き出したものですが、たとえば新規ブックで 以下のようなコードを書いたマクロブックを用意しておきます。 チェックファイル(選択画面で対象ファイルを1つまたは複数選択)あるいはチェックフォルダ(指定フォルダ内のすべてのブックを対象)を実行。 おかしなセルをこのマクロブックの最初のシートのA列に列挙します。 Sub チェックファイル() Dim sel As Variant Dim f As Variant Dim wb As Workbook Application.ScreenUpdating = False sel = Application.GetOpenFilename("ExcelBook,*.xlsx", Title:="対象ファイルを選んでください", MultiSelect:=True) If Not IsArray(sel) Then Exit Sub 'キャンセルボタン ThisWorkbook.Sheets(1).Columns("A").ClearContents For Each f In sel Set wb = Workbooks.Open(f) データチェック wb.Sheets("Sheet1") '★ wb.Close False Next Application.ScreenUpdating = True MsgBox "処理が終了しました" End Sub Sub チェックフォルダ() Dim fName As String Dim wb As Workbook Dim fPath As String Application.ScreenUpdating = False With Application.FileDialog(msoFileDialogFolderPicker) If Not .Show Then Exit Sub 'キャンセルボタン ThisWorkbook.Sheets(1).Columns("A").ClearContents fPath = .SelectedItems(1) fName = Dir(fPath & "¥*.xlsx") Do While fName <> "" Set wb = Workbooks.Open(fPath & "¥" & fName) データチェック wb.Sheets("Sheet1") '★ wb.Close False fName = Dir() Loop End With Application.ScreenUpdating = True MsgBox "処理が終了しました" End Sub Sub データチェック(shF As Worksheet) '============================= Dim comRow As Long Dim catRow As Long Dim comCol As Long Dim catCol As Long '============================= Dim w As Variant Dim x As Long Dim c As Range Dim a As Variant Dim f As Range Dim ok As Boolean Dim tmp As Long Dim r1 As Range Dim r2 As Range Dim r3 As Range Dim ck1 As Range Dim ck2 As Range Dim ck3 As Range Dim ck4 As Range Dim shT As Worksheet Dim mxCol As Long Dim mxRow As Long Dim nCols As Long Dim nRows As Long '=================================='データシートレイアウト規定 開始 '品番列 Set f = shF.Cells.Find(What:="品番", LookAt:=xlWhole, SearchOrder:=xlByRows) If Not f Is Nothing Then comCol = f.Column tmp = f.Row '数量(項目)列 Set f = shF.Cells.Find(What:="数量", LookAt:=xlWhole, SearchOrder:=xlByRows) If Not f Is Nothing Then If f.Row = tmp Then catCol = f.Column catRow = f.Row + 1 ok = True End If End If End If If Not ok Then MsgBox shF.Parent.Name & " のシートに、品番もしくは数量がないか、または同じ行ではないのでチェックをスキップします" Exit Sub End If mxRow = shF.Cells(Rows.Count, comCol).End(xlUp).Row 'データシートの品番列最終行番号 '品番開始行 comRow = shF.Cells(mxRow, comCol).End(xlUp).Row '=================================='データシートレイアウト規定 終了 nRows = mxRow - comRow + 1 'データシートの品番数 mxCol = shF.Cells(catRow, Columns.Count).End(xlToLeft).Column 'データシートの項目のデータ最終列を求める mxCol = mxCol + shF.Cells(catRow, mxCol).MergeArea.Columns.Count - 1 'そのセルの結合セルの列数を加味して、表の最終列を求める nCols = mxCol - Columns(catCol).Column + 1 '表の列数 nRows = mxRow - comRow + 1 'データシートの品番数 Set r1 = shF.Cells(comRow, comCol).Resize(nRows) '品番領域 Set r2 = shF.Cells(catRow, catCol).Resize(4, nCols) '項目領域 Set r3 = shF.Cells(comRow, catCol).Resize(nRows, nCols) 'データ領域 On Error Resume Next Set ck1 = Union(r1, r2).SpecialCells(xlCellTypeFormulas, xlErrors) '数式によるエラー値 Set ck2 = Union(r1, r2).SpecialCells(xlCellTypeConstants, xlErrors) '定数によるエラー値 Set ck3 = r3.SpecialCells(xlCellTypeFormulas, xlErrors + xlLogical + xlTextValues) '数式による数値以外 Set ck4 = r3.SpecialCells(xlCellTypeConstants, xlErrors + xlLogical + xlTextValues) '定数による数値以外 On Error GoTo 0 For Each a In Array(ck1, ck2, ck3, ck4) If Not a Is Nothing Then For Each c In a If IsArray(w) Then ReDim Preserve w(1 To UBound(w) + 1) Else ReDim w(1 To 1) End If w(UBound(w)) = c.Address(External:=True) Next End If Next If IsArray(w) Then With ThisWorkbook.Sheets(1) .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(w)).Value = WorksheetFunction.Transpose(w) End With End If End Sub (β) 2015/10/27(火) 19:09 ---- βさんおはようございます。 ありがとうございます! 場所がわかれば、だいぶ楽になりますね! 修正後のチェックにも使えそうです。 ありがとうございます! とりあえず、修正頑張ります>< (Lila) 2015/10/28(水) 08:45 ---- データを修正して、故障率コードを実行してみた所、データセルが全部「#DIV/0!」になってしまいました。 計算できていない?と言うことでしょうか?? (Lila) 2015/10/28(水) 09:31 ---- 今回の処理は Bシートを元にして、そこにある数値と、それに紐付く、Aシート、Cシートから導き出される部品総数から故障率を算出するものですので BシートのキーとAシート、Cシートから計算される総数のキーがマッチしなければ、分母がないわけですので、コード内で "#DIV/0!"をセットしています。 ここまでくれば、あとは、早い というか、いやいや、やっかいというか・・・・ なぜキーがマッチしないかという、今までもあった、これはやっかいな課題ですね。 もちろん、コードのバグということもありうるわけですが、(Lila) 2015/10/27(火) 16:25 では、いっったん集約できたわけですよね。 ということは、そのときのデータ(シート)と、データを修正して実行した、そのデータ(シート)との違いがどこかにある。 それを探ってもらえませんか。 各シートのキーとなるセルの値、これが、(今までもあったと思いますが)スペースがあったり、日付型ではなく文字列になっていたり 大文字小文字や全角半角・・・・ ちなみにキーとして扱っているのは Bシート A列の部品番号、3行目の日付 に対して Aシート A列の部品番号、1行目の集約コード および Cシート A列の日付、B列の集計区分 ですから、そのあたりのセルをチェックしてみてください。 コード面からアプローチするとすれば、 With shB と n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) にブレークポイントを設定し With shB で止まった時に ローカルウィンドウを表示して dicA と dicC の + をクリックして、その中のキーを表示させ n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) で止まった時に parts や sv や yyyymm にマウスを当てて値を確認、 その値で連結されたキーの文字列が dicAやdicCの中身としてあるのかないのか、ないとしたらなぜなのか、 そういった調査をしてもらうしかないですねぇ。 (β) 2015/10/28(水) 10:52 ---- > もちろん、コードのバグということもありうるわけですが、(Lila) 2015/10/27(火) 16:25 では、いっったん集約できたわけですよね。 > ということは、そのときのデータ(シート)と、データを修正して実行した、そのデータ(シート)との違いがどこかにある。 > それを探ってもらえませんか。 昨日夕刻の時と、今日の集約データの違いは「文字列」が無くなった事ですかね・・・。 部品コード〜英品名はAブック、Bブック共に同じ元データから引っ張ってきているので、ここは同一と考えて良いでしょう。 フィルターで見てみると、スペースが入っているセルがある場合チェック欄の隣が空白で何も書かれていないものがあり、それで解るのですが(使用数取り込みのデータにそういうものがありましたので、もちろん削除しました)、それも見当たらないようです。 > With shB と n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) にブレークポイントを設定し > With shB で止まった時に ローカルウィンドウを表示して dicA と dicC の + をクリックして、その中のキーを表示させ すみません;ローカルウィンドウ・・・とは・・・何でしょうか・・・? とりあえず「With shB」で停止させた時に入っていた値は 「dicA(k) = 0」(このとき、kにはA列最終行とAI1の値でした) 「dicC(k) = Empty 値(このときもkには上記と同じものでした) > n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) で止まった時に parts や sv や yyyymm にマウスを当てて値を確認、 > その値で連結されたキーの文字列が dicAやdicCの中身としてあるのかないのか、ないとしたらなぜなのか、 「parts」 と 「sv」にはそれぞれ、部品コードと商品名が入っていましたが、「yyyymm」は「 "" 」となり空白でした。 このあたりに問題がありそうな気がしますね。 とりあえず、日付セルをチェックしてみます。 (Lila) 2015/10/28(水) 11:40 ---- >>とりあえず、日付セルをチェックしてみます。 お願いします。 >>ローカルウィンドウ・・・とは・・・何でしょうか・・・? 変数の上にマウスをあてると値がポップアップされるわけですが、VBE画面の表示メニューで ローカルウィンドウ を選択すると、その時の変数が一覧ででてきますので、あれはどうなっている、これは、どうなっているという調査が やりやすくなっています。 で、配列やDIctinaryなんかは、+表示されていて、その +をクリックすると、その中身が表示されますので 是非活用してください。 (β) 2015/10/28(水) 13:47 ---- >>「parts」 と 「sv」にはそれぞれ、部品コードと商品名が入っていましたが、「yyyymm」は「 "" 」となり空白でした。 これはおかしいですね。 この yyyymm は、今から扱おうとしている、Bシート(元のBシートをコピーした新規ブックのBシート)上の数値セルの列の3行目にある日付です。 これが空白ということは、基本的にはあってはいけないことですからね。 (β) 2015/10/28(水) 13:54 ---- > >>とりあえず、日付セルをチェックしてみます。 特にこれと言ってセルに問題は無い気もしますが・・・ Bブックはセル表示こそ「yyyy/mm」ですが実際は「yyyy/mm/dd」でCブックと相違があるわけではないですし・・・ コードで「yyyymm」として実際は表示が「yyyymm」なだけで「yyyymmdd」だった場合、何か問題がありますでしょうか? > 変数の上にマウスをあてると値がポップアップされるわけですが、VBE画面の表示メニューで > ローカルウィンドウ を選択すると、その時の変数が一覧ででてきますので、あれはどうなっている、これは、どうなっているという調査が > やりやすくなっています。 > で、配列やDIctinaryなんかは、+表示されていて、その +をクリックすると、その中身が表示されますので > 是非活用してください。 なるほど。 そんな機能もあるのですね! 確かにたくさん入っているのを確認しました。 「dicA」に入っていたコードはありましたが、入っている商品名と続くものはありませんでした。 (Bブックにはあっても、Aブックにない商品でした) 「dicC」に日付+商品名はありました。 >「With shB」で停止させた時 に出てくる新規ブックには、ちゃんと数値がコピー(?)されていました。 (Lila) 2015/10/28(水) 14:14 ---- セルのチェックをしていただき、どこかおかしなセルを発見いただければいいのですが、最後の手段(?)として。 momoさんのユーティリティで、実際のレイアウトをアップする手法はすでに使ってもらっていますが これでは、そのセルの中身が実際にどうなっているのかがみえません。 以下に紹介するのは、「学校」内で、半平太さんが掲載された、これまたすぐれもののユーティリティで 実際に、そのシートを復元するマクロを自動生成します。 ・新規ブックに、以下に紹介するコード(とても長いです)を貼り付けて、調査用マクロブックとしておきます。 ・調査したいブックを開き、調査したいシートを選択して、そのシートのデータ領域をマウスで選択します。 (A1:AN100 とか) ・この状態で、レイアウトとサンプルデータ再現マクロ作成 を実行します。 ・マクロブックの 出力Wshというシート(なければ自動生成されます)にマクロコードが書きこまれます。 ・この書きこまれたコードを掲示板にアップいただくと、そちらで実際に使っておられるシートと同じ内容を持ったシートを こちらで作り出して検証することが可能になります。 ・今回の場合、Aシート、Bシート、Cシートで、実行して、それぞれでできあがる3つのこー^度をアップしてもらえれば 助かります。 以下コードです(長いですががまんしてください) Public Sub レイアウトとサンプルデータ再現マクロ作成() Const modelMRG As String = " Range(""Adrs"").Merge" Const modelCLR As String = " Range(""Adrs"").Interior.ColorIndex = " Const modelVAL2 As String = " Range(""Adrs"").Value = " Const modelFML As String = " Range(""Adrs"").FormulaR1C1Local = " Const modelFMT As String = " Range(""Adrs"").NumberFormatLocal = ""@""" '文字列(頭が「'」のデータ処理 Const modelFME As String = " Range(""Adrs"").NumberFormatLocal = " '標準外の表示形式 Dim WSF As WorksheetFunction Dim rslt Dim dataToFil Dim cel As Range Dim Codes As String Dim NN As Long, PP As Long Dim BlocksToRight As Long, BlocksToBottom Dim rngSelected As Range Set rngSelected = Intersect(Selection, Selection.Parent.UsedRange) If rngSelected.Rows.Count > 2000 Or _ rngSelected.Columns.Count > 100 Then MsgBox "範囲が広すぎます" Exit Sub End If Set WSF = WorksheetFunction On Error Resume Next ThisWorkbook.Sheets("出力Wsh").Range("A1").Value = Empty 'シート存在テスト If Err.Number <> 0 Then ThisWorkbook.Sheets.Add.Name = "出力Wsh" End If On Error GoTo 0 NN = 0 With ThisWorkbook.Sheets("出力Wsh") NN = NN + 1: .Cells(NN, 1).Value = "Private Sub onlyOnce()" NN = NN + 1: .Cells(NN, 1).Value = "Rem ' Range(""" & rngSelected.Address(, , , True) & """).Clear" NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 結合状態を処理" For Each cel In rngSelected '結合状態を処理---------------- With cel If .MergeCells Then '結合状態になっているセルを処理 If .MergeArea.Item(1).Address = .Address Then NN = NN + 1 dataToFil = Replace(modelMRG, "Adrs", .MergeArea.Cells.Address(0, 0)) ThisWorkbook.Sheets("出力Wsh").Cells(NN, 1).Value = dataToFil End If End If End With Next NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セル以外をまとめて処理" rslt = sameKindS(rngSelected, modelVAL2, "値") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 数式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFML, "数式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 標準外書式セルをまとめて処理" rslt = sameKindS(rngSelected, modelFME, "セル書式") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = Empty NN = NN + 1: .Cells(NN, 1).Value = " Rem 塗りつぶしセルをまとめて処理" rslt = sameKindS(rngSelected, modelCLR, "塗りつぶし") For PP = LBound(rslt) To UBound(rslt) If rslt(PP) <> Empty Then NN = NN + 1: .Cells(NN, 1).Value = rslt(PP) End If Next PP NN = NN + 1: .Cells(NN, 1).Value = "End Sub" ' .Range("A1").Resize(NN, 1).Copy End With End Sub Private Function sameKindS(rng As Range, modelFMS, Optional aim As String = "値") '一般形 Dim dic As Object Dim cel As Range Dim Adrs As String Dim AdrsBreak Dim sNum As String Dim eachKey Dim NN As Long Dim dataToFil Dim ItemVal Set dic = CreateObject("Scripting.Dictionary") ' 連想配列の定義 For Each cel In rng ItemVal = Empty Select Case aim Case "値" If Not cel.HasFormula And Not IsEmpty(cel.Value) Then ItemVal = IIf(IsError(cel.Value2), cel.Formula, cel.Value2) End If Case "数式" If cel.HasFormula Then ItemVal = cel.FormulaR1C1Local End If Case "セル書式" If cel.NumberFormatLocal <> "G/標準" And _ TypeName(cel.Value) <> "Currency" Then '標準外の書式を反映させる。通貨型は面倒なので処理外 ItemVal = cel.NumberFormatLocal End If Case "塗りつぶし" If cel.Interior.ColorIndex <> -4142 Then '塗りつぶしがあるセルを処理 ItemVal = cel.Interior.ColorIndex End If End Select If Not IsEmpty(ItemVal) Then If dic.Exists(ItemVal) Then AdrsBreak = Split(dic(ItemVal), "#") sNum = AdrsBreak(0) + 1 dic(ItemVal) = sNum & "#" & AdrsBreak(1) & cel.Address(0, 0) & " " Else dic.Add ItemVal, "1#" & cel.Address(0, 0) & " " End If End If Next Dim rslt() Dim brd ReDim rslt(0 To Application.Max(0, dic.Count - 1)) NN = 0 For Each eachKey In dic AdrsBreak = Split(dic(eachKey), "#") Adrs = Replace(RTrim(AdrsBreak(1)), " ", ",") Adrs = AddressUnited(Adrs) 'バラバラのAddressを統合 For Each brd In Split(Adrs, "#!#") If brd <> "" Then dataToFil = IIf(Application.IsText(eachKey), """", "") & Replace(eachKey, """", """""") & _ IIf(Application.IsText(eachKey), """", "") dataToFil = Replace(modelFMS, "Adrs", brd) & dataToFil NN = NN + 1 If NN - 1 > UBound(rslt) Then ReDim Preserve rslt(0 To NN - 1) End If rslt(NN - 1) = dataToFil End If Next Next sameKindS = rslt End Function Private Function AddressUnited(adr) 'バラバラのAddressを統合 Dim scopeRange As Range Dim adrRemain As String Dim adrForRowProc As String Dim adrForColProc As String Set scopeRange = Range(Split(adr, ",")(0)) adrRemain = "," & adr & "," Do While Not scopeRange Is Nothing uniteRowDir scopeRange, adrRemain adrForRowProc = adrForRowProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop Set scopeRange = Range(Split(adrForRowProc & ",", ",")(0)) adrRemain = "," & adrForRowProc Do While Not scopeRange Is Nothing uniteColDir scopeRange, adrRemain adrForColProc = adrForColProc & scopeRange.Address(0, 0) & "," If Len(adrRemain) < 4 Then Set scopeRange = Nothing Else Set scopeRange = Range(Split(adrRemain, ",")(1)) End If Loop AddressUnited = get小分け(adrForColProc) '10セル以上は長いので同じ構文でも分割作成 End Function Function get小分け(adrForColProc) Dim strSRC Dim brDown, Cntr, sss, QQ, adrsUnit, numOfadrs brDown = Split(adrForColProc, ",") numOfadrs = UBound(brDown) '対象個数 adrsUnit = Int((numOfadrs - 1) / 10) + 1 adrsUnit = Application.RoundUp(UBound(brDown) / adrsUnit, 0) 'まとめるアドレスの数 For Cntr = 0 To numOfadrs - 1 Step adrsUnit sss = stEd(Cntr, Application.Min(numOfadrs - 1, Cntr + adrsUnit - 1), brDown) strSRC = IIf(strSRC = "", sss, strSRC & "#!#" & sss) Next Cntr get小分け = strSRC & "#!#" End Function Function stEd(st, ed, ary) Dim NN, str str = ary(st) For NN = st + 1 To ed str = str & "," & ary(NN) Next NN stEd = str End Function Private Sub uniteRowDir(ByRef scopeRange, ByRef adrRemain) Dim brdAry brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & brdAry(1) & ",", ",") 'アドレス文字列から除外 If Range(brdAry(1)).Cells(1, 2).Address(0, 0) = brdAry(2) Then '右横に同じものあり Set scopeRange = Range(scopeRange, Range(brdAry(2))) uniteRowDir scopeRange, adrRemain End If End Sub Private Sub uniteColDir(ByRef scopeRange, ByRef adrRemain) '直下が同じ範囲かチェック Dim brdAry Dim adrsUnder As String brdAry = Split(adrRemain, ",") adrRemain = Replace(adrRemain, "," & scopeRange.Rows(scopeRange.Rows.Count).Address(0, 0) & ",", ",") 'アドレス文字列から除外 adrsUnder = scopeRange.Rows(scopeRange.Rows.Count + 1).Address(0, 0) '結合セル対策 If adrRemain Like "*," & adrsUnder & ",*" Then '真下に同じものあり Set scopeRange = Range(scopeRange, Range(adrsUnder)) uniteColDir scopeRange, adrRemain End If End Sub (β) 2015/10/28(水) 14:19 ---- まず、Aシートです。 Private Sub onlyOnce() Rem ' Range("[部品データベース.xlsm]Sheet2!$A$1:$G$15").Clear Rem 結合状態を処理 Rem 数式セル以外をまとめて処理 Range("B1").Value = "SS500" Range("C1").Value = "YG500" Range("D1").Value = "AB050" Range("E1").Value = "CD550" Range("F1").Value = "ABC300" Range("G1").Value = "CDE150" Range("A3").Value = "MP-*EMC-13HK-3D" Range("A4").Value = "MP-*IP085C-SDM5" Range("A5").Value = "MP-*M201400" Range("A6").Value = "MP-00021182" Range("A7").Value = "MP-00021205" Range("A8").Value = "MP-00030687" Range("A9").Value = "MP-00880152" Range("D9:E9,G9").Value = 8 Range("F9").Value = 4 Range("A10").Value = "MP-01020542" Range("A11").Value = "MP-01021194" Range("A12").Value = "MP-01030026-2" Range("A13").Value = "MP-01030655" Range("A14").Value = "MP-01031117" Range("A15").Value = "MP-0103137" Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Rem 塗りつぶしセルをまとめて処理 End Sub Range("A7").Value = "MP-*M201400" Range("B7").Value = "ヘッド固定ブロック" Range("C7").Value = "HEAD FIXING BLOCK" Range("A8").Value = "MP-00021182" Range("B8,B12").Value = "モータ ASSY (X)" Range("A9").Value = "MP-00021205" Range("B9,B13").Value = "モータ ASSY (Y)" Range("C9").Value = "Y MOTOR" Range("A10").Value = "MP-00030687" Range("B10").Value = "紙センサー板ASSY(A1)" Range("A11").Value = "MP-00880152" Range("B11").Value = "取扱いマーク銘板" Range("C11").Value = "NAME PLATE-HANDLING MARK" Range("A12").Value = "MP-01020542" Range("A13").Value = "MP-01021194" Range("C13").Value = "Y MOTOR ASSY CG-90I" Range("A14").Value = "MP-01030026-2" Range("B14").Value = "グリップローラ (単品価格)" Range("A15").Value = "MP-01030655" Range("B15").Value = "テンションプーリ ASSY" Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Range("E2:AB2").NumberFormatLocal = "yyyy/mm" Range("A4:C15").NumberFormatLocal = "@" Rem 塗りつぶしセルをまとめて処理 End Sub (Lila) 2015/10/28(水) 15:40 ---- Bシートです Private Sub onlyOnce() Rem ' Range("[故障部品データベース.xlsm]Sheet1!$A$1:$AB$15").Clear Rem 結合状態を処理 Range("A1:A3").Merge Range("B1:B3").Merge Range("C1:C3").Merge Range("D1:D3").Merge Range("E1:P1").Merge Range("Q1:AB1").Merge Rem 数式セル以外をまとめて処理 Range("A1").Value = "部品コード" Range("B1").Value = "品名" Range("C1").Value = "英語品名" Range("E1").Value = "AB050" Range("Q1").Value = "CD550" Range("E2,Q2").Value = 41944 Range("F2,R2").Value = 41974 Range("G2,S2").Value = 42005 Range("H2,T2").Value = 42036 Range("I2,U2").Value = 42064 Range("J2,V2").Value = 42095 Range("K2,W2").Value = 42125 Range("L2,X2").Value = 42156 Range("M2,Y2").Value = 42186 Range("N2,Z2").Value = 42217 Range("O2,AA2").Value = 42248 Range("P2,AB2").Value = 42278 Range("A5").Value = "MP-*EMC-13HK-3D" Range("B5").Value = "電源装置 保守用" Range("A6").Value = "MP-*IP085C-SDM5" Range("B6").Value = "照射器具 保守用" Range("C6").Value = "UV LIGHTING UNIT" Range("A7").Value = "MP-*M201400" Range("B7").Value = "ヘッド固定ブロック" Range("C7").Value = "HEAD FIXING BLOCK" Range("A8").Value = "MP-00021182" Range("B8,B12").Value = "モータ ASSY (X)" Range("A9").Value = "MP-00021205" Range("B9,B13").Value = "モータ ASSY (Y)" Range("C9").Value = "Y MOTOR" Range("A10").Value = "MP-00030687" Range("B10").Value = "紙センサー板ASSY(A1)" Range("A11").Value = "MP-00880152" Range("B11").Value = "取扱いマーク銘板" Range("C11").Value = "NAME PLATE-HANDLING MARK" Range("A12").Value = "MP-01020542" Range("A13").Value = "MP-01021194" Range("C13").Value = "Y MOTOR ASSY CG-90I" Range("A14").Value = "MP-01030026-2" Range("B14").Value = "グリップローラ (単品価格)" Range("A15").Value = "MP-01030655" Range("B15").Value = "テンションプーリ ASSY" Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Range("E2:AB2").NumberFormatLocal = "yyyy/mm" Range("A4:C15").NumberFormatLocal = "@" Rem 塗りつぶしセルをまとめて処理 End Sub (Lila) 2015/10/28(水) 15:41 ---- Cシートです。 実際に使用しているCシートからフィルターでBシートに乗っている2種類のみの数値を出しています。 Private Sub onlyOnce() Rem ' Range("'[30-21 MTBF 機種別小分類.xlsx]Sheet1'!$A$1:$C$25").Clear Rem 結合状態を処理 Rem 数式セル以外をまとめて処理 Range("A1").Value = "設定月" Range("B1").Value = "集計区分" Range("C1").Value = "稼働台数" Range("A2:A3").Value = 42278 Range("B2,B4,B6,B8,B10,B12,B14").Value = "AB050" Range("C2").Value = 60 Range("B3,B5,B7,B9,B11,B13,B15:B25").Value = "CD550" Range("C3").Value = 654 Range("A4:A5").Value = 42248 Range("C4,C24").Value = 57 Range("C5").Value = 651 Range("A6:A7").Value = 42217 Range("C6").Value = 37 Range("C7").Value = 598 Range("A8:A9").Value = 42186 Range("C8").Value = 28 Range("C9").Value = 565 Range("A10:A11").Value = 42156 Range("C10").Value = 21 Range("C11").Value = 529 Range("A12:A13").Value = 42125 Range("C12").Value = 10 Range("C13").Value = 491 Range("A14:A15").Value = 42095 Range("C14").Value = 2 Range("C15").Value = 465 Range("A16").Value = 42064 Range("C16").Value = 438 Range("A17").Value = 42036 Range("C17").Value = 354 Range("A18").Value = 42005 Range("C18").Value = 317 Range("A19").Value = 41974 Range("C19").Value = 282 Range("A20").Value = 41944 Range("C20").Value = 242 Range("A21").Value = 41913 Range("C21").Value = 207 Range("A22").Value = 41883 Range("C22").Value = 175 Range("A23").Value = 41852 Range("C23").Value = 104 Range("A24").Value = 41821 Range("A25").Value = 41791 Range("C25").Value = 16 Rem 数式セルをまとめて処理 Rem 標準外書式セルをまとめて処理 Range("A1:A25").NumberFormatLocal = "yyyy/mm/dd" Rem 塗りつぶしセルをまとめて処理 Range("A1:C1").Interior.ColorIndex = 15 End Sub Rem 塗りつぶしセルをまとめて処理 End Sub (Lila) 2015/10/28(水) 15:48 ---- 作業ありがとうございました。 結果からいえば、momoさんのユーティリティでレイアウトアップいただいてもわかったことでした。 Bシートですが、日付行は 3行目じゃなかったですか? そちらで使っているシートは2行目のようですね。3行目は空白行。 なので、yyyymm がすべて"" になり、マッチしないということなんですが、 2行目、3行目、どちらが正しかったですか? (β) 2015/10/28(水) 17:11 ---- > Bシートですが、日付行は 3行目じゃなかったですか? > そちらで使っているシートは2行目のようですね。3行目は空白行。 > なので、yyyymm がすべて"" になり、マッチしないということなんですが、 > 2行目、3行目、どちらが正しかったですか? なるほど、見ている行が違ったのですね! 恐らく、3行目はレイアウトを変えた方が・・・と迷っていた時に、1行目をグループとして一瞬だけ此処にレイアウトとして出したものだったかと思います。 2行目が現在のシートになって居ます。 変更箇所は >yyyymm = Format(c.EntireColumn.Cells(3).Value, "yyyymm") の (3) を (2) にする形で合っていますか?? (Lila) 2015/10/28(水) 17:17 ---- >>の (3) を (2) にする形で合っていますか?? はい。そのように変更してください。 (β) 2015/10/28(水) 17:23 ---- βさん、おはようございます! 問題なく、結果が表示されました! ありがとうございます!! 例えば、書き出しを新規ブックではなく、Bブックのシート2等にしたい場合、 >Set shB = ActiveWorkbook.Sheets(1) ここを >Set shB = ThisWorkbook.Sheets("Sheet2") こう変更でBブックのシート2へ書き出しされるのでしょうか?? (Lila) 2015/10/29(木) 08:43 ---- それだけでは、だめですね。 現在のコードは ThisWorkbook.Sheets("Sheet1").Copy '故障部品 Set shB = ActiveWorkbook.Sheets(1) つまり、既存の Sheet1の内容をいったんコピーして、それを加工します。 ですから、これをマクロブックのSheet2にするなら、 Set shB = ThisWorkbook.Sheets("Sheet2") shB.Cells.Clear ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") こんなコードになりますね。 (β) 2015/10/29(木) 09:57 ---- なるほど・・・ これは > Set shB = ThisWorkbook.Sheets("Sheet2") 「shB」にマクロブックのシート2を格納して > shB.Cells.Clear シート2の情報をクリアして > ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") シート1をコピーして、シート2のA1へ貼り付け・・・ と言うことでしょうか・・・。 こうして細かく区切ったコードだと、なんとなくどういう動作をしているのか、判ってきましたが、じゃあこれを加工してみろと言われると、まだまだ「???」状態ですね・・・^^; (Lila) 2015/10/29(木) 10:13 ---- はい、この3行でやっていることは Lilaさんの理解の通りです。 確かに長いコードだと、見るだけでうんざりということがあるかもしれませんが、丹念に(がまんして)おいかけていくと しょせんが細かく区切ったコードの寄せ集めですから、きっと理解もできるし、加工もできるようになると思いますよ。 (β) 2015/10/29(木) 10:29 ---- コードの羅列を見て考えることは、うんざりというより、焦るというか、頭が真っ白になってしまうような感じですね^^; 焦る必要も無いのに、慌ててしまう感じです。 中間あたりのコードはまだ何をしているか判らないコードでいっぱいですし・・・ とりあえず、色々触って実践しながらまた解らないことが出ましたら、質問させて頂きに来ます(^o^)/ βさん、ありがとうございました! (Lila) 2015/10/29(木) 10:40 ---- ・・・と、完了したと思ったら、問題が発生していました・・・;; A、B、C のいずれかのブックに無いものは計算不可能なので結果出力されず問題ないのですが、全てのブックにあるものが計算されていませんでした・・・;;(Bブックの丁度中間あたりでした) とりあえずAブック集約シートとBブックの大項目同士が合っているのか確認します・・・ (Lila) 2015/10/29(木) 11:02 ---- ↑は、ただ単に私の表記ミス(大項目と中項目を結ぶだけではなく間に「-」が入るものがあるので、そこの記載ミスでした。 大項目の後ろに「-」をつけるなどして、ここは対応しようと思います。 そして、計算結果を出した後に、グループ分けをしたのですが、 グループ分けタブで4行目(A4セル)に記載したグループに、5行目(A5セル)のグループに入らなければいけないものがひとつ入ってしまいました・・・ そのA4セルグループに入ってしまったものは、ちゃんと5行目に記載しています(B5セル) これはどういった事が考えられますでしょうか・・・? (Lila) 2015/10/29(木) 11:20 ---- 元々が、各人のやりかたで、入力様式が多種多様というものを集約しているようですので、 Lilaさんの補正作業も大変だなと感じます。 難しいとは思いますが、やはり、集計ということを、各人に理解してもらい、入力様式の統一をお願いしていくということも 必要だと思います。 それはさておき。 >>計算結果を出した後に、グループ分けをしたのですが これは、前回の結果シートをグループコード別に別シートに分割した、その方法で、今回の Bシートを シート分割したということですか? で、そこで、正しくグループ分けされなかったということなら、そのコードをアップしてもらわないと コメントができないのですが? そうではなく、今回の処理そのもので不具合があったということですか? (β) 2015/10/29(木) 11:38 ---- > 元々が、各人のやりかたで、入力様式が多種多様というものを集約しているようですので、 > Lilaさんの補正作業も大変だなと感じます。 > 難しいとは思いますが、やはり、集計ということを、各人に理解してもらい、入力様式の統一をお願いしていくということも必要だと思います。 そうですねぇ・・・。 その通りだと思いますが、実際の所、何を言っても聞く耳をお持ちでないようなので・・・。 社員の方々が気付くしかないですし、この辺りはいずれ私が退職した後に泣けばいいと思います。 > これは、前回の結果シートをグループコード別に別シートに分割した、その方法で、今回の Bシートを > シート分割したということですか? > で、そこで、正しくグループ分けされなかったということなら、そのコードをアップしてもらわないと > コメントができないのですが? 今回の計算が完成する前に、未計算のBシートを分割するコードを頂いていたので、計算後のBシートをグループ分けしたのですが(コードは頂いたものの"Sheet1" を "Sheet2"に変更したのみ)、そこでの不具合(?)です。 コードを見ていて、ん?と思ったのですが、もしかして「12」を「6」に変更すれば良いだけの事でしょうか・・・??? (未計算時は12ヶ月だが、計算後は6ヶ月なので) 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 Dim shn As Variant Dim r As Range Dim d As Range 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("Sheet2") '元シート 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 '空白行の削除 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 End Sub (Lila) 2015/10/29(木) 11:49 ---- いま、そうかなと思ってレスしようとしたところでした。 はい。Aシートは12列単位で分割していますが、できあがりのBシートは6列単位なので 後ろの6列が、どのグループであろうと、その前のグループとして分割されてしまいます。 コード内で 12 が何回か登場しますので、それらをすべて 6 に変更して試してください。 (β) 2015/10/29(木) 11:54 ---- まったくテーマとは異なりますが。 今回のように 分割マクロ を複数種類、ロジックはほとんど同じで、ほんのちょっと条件が異なるものを作っておくと 要件変更などがあった場合、複数、間違いなく同じように変更が必要になります。 これを共通プロシジャとして作っておくと、ロジックが1か所になり、保守性が向上します。 いずれ、余力ができたおりに検討してみてください。 以下の例は、わざわざ共通化するまでもないシンプルなものですが、考え方として。 ●別々に用意するパターン。 Sub 処理1() Dim sh As Worksheet Set sh = Sheets("Sheet1") sh.Range("A5").Value = "ABC" End Sub Sub 処理2() Dim sh As Worksheet Set sh = Sheets("Sheet2") sh.Range("B8").Value = "XYZ" End Sub ●共通プロシジャ化したパターン Sub 処理1() 共通処理 Sheets("Sheet1"), "A5", "ABC" End Sub Sub 処理2() 共通処理 Sheets("Sheet2"), "B8", "XYZ" End Sub Sub 共通処理(sh As Worksheet, adr As String, val As String) sh.Range(adr).Value = val End Sub (β) 2015/10/29(木) 14:42 ---- βさん、ありがとうございます。 無事シートをグループごとに分けられました>< 共通プロシジャ・・・ 以前作っていただいた「フォルダ又はファイルを読み込む」みたいなものの事・・・でしょうか・・・??? (Lila) 2015/10/29(木) 15:36 ---- そうですね。 たとえば今回の分割が同じマクロブックにあるなら Sub 分割(fSh as Worksheet,cols as Long) といった記述にして、中にある Dim fSh as Worksheet を消し、12 や 6 を cols にしておけば 使う場合は Sub 分割1() 分割 Sheets("Sheet1"),12 End SUb とか Sub 分割2() 分割 SHeets("Sheet1"),6 End Sub こんな感じになります。 (β) 2015/10/29(木) 15:59 ---- 呼び出すときはプロシージャ名この場合は"分割"で呼び出すことができるのですか・・・! ちょっとこの辺り理解できていなかったです。 分割の方には、 > Sub 分割(fSh as Worksheet,cols as Long) > といった記述にして、中にある Dim fSh as Worksheet を消し、12 や 6 を cols にしておけば ここを修正した、コードを書いておき > Sub 分割1() > 分割 Sheets("Sheet1"),12 > End SUb 12行欲しかったらこちらで呼び出し > Sub 分割2() > 分割 SHeets("Sheet1"),6 > End Sub 6行の時はこちらで呼び出す、という事ですか?? 以前の部品更新の時のコードで言うと、 どちらも Sub 使用部品更新1 or 2() 〜〜〜 Sub の後ろに Sub 更新() データ取り込み SHeets("シート名") End Sub とすれば呼び出せると言うことですか?? あ、あとすいません。 >shB.Cells.Clear で消されるのは「Sheet2」のセル値だけで、例えばマクロを登録したボタン(図形)はそのまま上書き、というか上にいくつも重なっていってしまいますか? (Lila) 2015/10/29(木) 16:17 ---- まず、共通サブルーティン化については、ちょっと、お先走ったかもしれませんね。 かえって混乱させたのかな? たとえば、今のBブックに変換前の12列単位のSheet1と変換後の6列単位のSHeet2がありますね。 分割 をコメントしたような構造にしておいて、 Sub 分割A() 分割 Sheets("Sheet1"),12 'あるいは Call 分割(SHeets("Sheet1"),12) End SUb Sub 分割B() 分割 Sheets("Sheet2"),6 'あるいは Call 分割(SHeets("Sheet2"),6) End SUb こうすれば、異なるシートの分割が、1つのプロシジャで処理できますよということなんです。(それが必要なら) で、シート上のボタンの件。 Cells.Copy とやると、ボタンもコピーされます。 でも Cells.Clear ではボタンはクリアされません。 ですから、コピー元にボタンがあって、この処理を繰り返すと、コピー先にボタンがどんどん追加されていきますね。 対処方法は3つ。 1.コードを変更して、ボタンをコピーせず、そのほかのものは(セルの結合状態含めて)コピーするというやりかたにかえる。 2.コピーしたあとボタンを消すコードを追加。 3.コピー元シートにはボタンはおかない。別途、操作シートをつくり、そのシート上に、Bブック上で行うボタンを配置する。 3.ならコード変更不要です。 2.なら ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") の下に shB.Buttons.Delete をいれてください。 ★ただし、それがボタンではない場合、からぶりします。図形というのは具体的に何ですか? オートシェープでしょうか?あるいは、図 でしょうか? それによって、削除するコードがかわりますので。 (β) 2015/10/30(金) 07:55 ---- つまり、故障部品だけの1年数値のままグループタブ分けと計算後のグループタブ分けがひとつのモジュールで出来ますよ、という事でしょうか? > ★ただし、それがボタンではない場合、からぶりします。図形というのは具体的に何ですか? > オートシェープでしょうか?あるいは、図 でしょうか? > それによって、削除するコードがかわりますので。 挿入タブの図形ですね。 矢印とかハートとか出来るあれです。 (Lila) 2015/10/30(金) 08:25 ---- >>1年数値のままグループタブ分けと計算後のグループタブ分けがひとつのモジュールで う〜ん・・・モジュールという概念とは違うんですが・・・ ↑であげた例を踏まえると 「分割」という「1つのプロシジャ」で、6か月シートも12か月シートも処理できますよということなんです。 分割A、分割B、それと、分割。この3つは、同じ【モジュール】に配置したほうがわかりやすいでしょうけど、別々のモジュールに記述してもいいんです・・・ ちょっとわかりにくいですかね? で、図形の削除ですけど、ループで取り出して形式を調べながら削除するのが安全なんですが、面倒なので shB.Shapes.SelectAll Selection.Delete ↑で連絡した shB.Buttons.Delete のかわりに、この2行を。 (β) 2015/10/30(金) 09:07 ---- > ↑であげた例を踏まえると 「分割」という「1つのプロシジャ」で、6か月シートも12か月シートも処理できますよということなんです。 > 分割A、分割B、それと、分割。この3つは、同じ【モジュール】に配置したほうがわかりやすいでしょうけど、別々のモジュールに記述してもいいんです・・・ 別のモジュールに配置しておいて、また別のモジュールで好きな組み合わせ「分割」+「分割A」、「分割」+「分割B」、「分割」+「分割A」+「分割B」という呼び出しを作成できるということですか・・・??? >↑で連絡した shB.Buttons.Delete のかわりに、この2行を。 追加して実行してみました! 削除は出来ていなかったようですが、選択状態になっていたので、楽に消せました^o^! ありがとうございます! (Lila) 2015/10/30(金) 09:17 ---- >>削除は出来ていなかったようですが わぁ、ごめんなさい。必ずしも、このシートがアクティブシートではなかったですね。 しかも、その場合、図形が削除されないだけではなく、実行時にアクティブだったシートで選択されていたセルが削除されてしまうという とんでもない、間違いコードでした。 1.Selection.Delete を消して操作で削除してもらうか、あるいは、 2.Dim Sp As Shape を追加したうえで shB.Shapes.SelectAll Selection.Delete これをやめて For Each sp In shB.Shapes sp.Delete Next ところで、共通プロシジャについては、ちょっとお先走った提案だったかも。 これはこれで、じっくりと、説明したほうがいいと思います。 ご希望なら、少しまとまったメモを作成します。 あるいは、それは、将来のテーマとして、今は、そのことを忘れてもらってもいいですが。 (β) 2015/10/30(金) 10:00 ---- なるほど、アクティブシートでないと削除されないというコードだったのですね。 2のコードでばっちり削除されました! ありがとうございます^o^ > ところで、共通プロシジャについては、ちょっとお先走った提案だったかも。 > これはこれで、じっくりと、説明したほうがいいと思います。 > ご希望なら、少しまとまったメモを作成します。 分けて実行する、というのが良くわかってないので、以前のコードもそのまま同じモジュールに貼り付けています・・・^^; βさんさえ良ろしければ、是非お願いします! (Lila) 2015/10/30(金) 10:16 ---- まず、標準モジュールについて整理しましょう。 標準モジュールはVBE画面で、挿入することによって初期値の名前としては Module1、Module2、・・・と何枚でも作成できますね。 もちろん、Module1 だけで、そこにすべてのマクロを記述してもいいですし、処理の種類別にマクロを分けて配置してもいいですし、 あるいは Module1にはメイン処理、Module2には共通サブプロシジャといったようにわけて配置してもいいですね。 Moduleを自宅の部屋だと考えて、すべて1部屋だけに家具を詰め込んで、そこだけで生活するのもいいですし 寝室や勉強部屋や仕事部屋といったようにわけてもいいですね。「標準モジュール」とは、そういった「部屋」です。 次に、「プロシジャ」を考えましょう。いわゆるマクロ、Sub から End Sub までの処理プログラムのことです。 Sub 処理1() MsgBox "Hello" End Sub Sub 処理2() MsgBox "Good Bye" End Sub こんな2つのプロシジャがあったとします。これらが、同じモジュールにあるか別々のモジュールにあるか、 それは実行上、どちらでもかわりません。いずれにしても、単独で動く2つの実行マクロがあるわけですね。 で、この例は、単純な例なんですが、この中身(MsgBoxだけの部分)が、今回の分割処理のような長いコードだったとします。 処理1 が 12列用、処理2が 6列用だったとします。 で、今回のように、コピーしたあと図形を削除したいといった要件がでたとします。 あるいは、今までもあったようにロジックに間違いがあって、そこを修正するとします。 そうすると、2つのコードを同じように直さなきゃいけませんね。 もう1つ、別のポイントで。 Sub 処理1() MsgBox "Hello" End Sub これは、単独で実行可能なプロシジャ(マクロ)ですね。 この形式の他に Sub hoge(引数群) 引数を参照した処理 End SUb こんなプロシジャを書くことができます。 (引数は、本来は「いんすう」が正しい読み方ですが、「因数」等との区別のため「ひきすう」と呼ぶのが一般的です) たとえば Sub 処理1() hoge "Hello" End Sub Sub Hoge(s As String) MsgBox s End Sub 処理1 では、実際の処理を行わず、実際の処理を行う Hoge というサブプロシジャに 引数として "Hello" を渡し Hoge では、渡された引数を参照して処理を行います。 こうしておけば、処理2 のほうも Sub 処理2() hoge "Good Bye" End Sub と書くだけで、実際の処理は Hoge がやってくれます。 なにか変更があった場合、Hoge を変更すれば 処理1 も 処理2 も、変更後のロジックで動くことになります。 この時、処理1、処理2、Hoge を 同じモジュールに書こうが、別モジュールに分けて書こうが、それは実行とは関係のない話。 どのようにモジュール分けをしておいたらLilaさんが管理しやすいかという、そういった観点で1つもモジュールにするなり 別々のモジュールにするなり、そこは好きなように配置すればいいんです。 例では、引数として 1 つだけを与えましたが、共通的に使われるロジックの中で、処理ごとに異なる条件、 対象シートであったり、処理単位の列数であったり、異なる条件分、2つだったり3つだったり4つだったり、必要なだけ与えます。 今回の分割で、その形をとろうとした場合、もしかしたら、分割後のシート名をどうするのかも条件になるかもしれませんね。 さもなければ 処理1 も 処理2 も、同じシート名として作成、結果、先に作ったシートが後の処理で上書きされますので。 とりあえず、ここまで。 わからないところがあれば(あると思いますが)遠慮なく質問してください。 (β) 2015/10/30(金) 11:19 ---- とすると、以前の更新プロシジャでするところの ファイルを開く や フォルダを開く というのを実行していたのは使用部品更新プロシジャではなく、データ取り込みプロシジャで行っている・・・?という考え方でしょうか (Lila) 2015/10/30(金) 11:40 ---- その実例で説明したほうがわかりやすかったですね。 共通プロシジャに渡す引数も1つだけのシンプルなものでしたから。 マクロ名は何でもいいのですが、 Test1 これは、対象ブックを複数選んで処理。 Test2 これは、対象フォルダを1つ選んで、その中のすべてのブックを対象にして処理。 処理そのものは全く同じなんですが、ブックを選択する方式が異なるので、別のマクロ(Test1とTest2)にせざるを得なかったわけです。 Sub Test1() ファイル選択ダイアログから対象ブックを複数選択 複数選択されたブックを1つずつ繰り返しで取得 そのブックを開く データ取り込み wb.Sheets("データシート") '★データ取り込み実行 繰り返し End Sub Sub Test2() フォルダ選択ダイアログで対象フォルダを1つ選択 フォルダ内のブックを1つずつ繰り返しで取得 そのブックを開く データ取り込み wb.Sheets("データシート") '★データ取り込み実行 繰り返し End Sub で、これらとは別に Sub データ取り込み(shF As Worksheet) 長〜い処理コード End Sub これが「1つだけ」記述されていたわけですね。 Test1やTest2では、それぞれで開いたブックのシートを引数として データ取り込み に渡して処理させます。 このデータ取り込み処理については、要件変更や不具合修正等で、何度も手を入れましたね。 仮に、このデータ取り込み部分が、共通プロシジャ化されておらず、Test1とTest2の★のところに それぞれ、長〜いコードを記述してあったとしますと、変更のたびに、2つのマクロを修正しなければいけなかったわけです。 でも、「処理」の部分を、切り出して、共通プロシジャ化しておくことによって、変更作業は データ取り込み マクロのみでよかったですね。 ご質問の ファイルを開くのはどこがやっているかということについては、Test1 または Test2 で、それぞれやっています。 開いたブックのシート処理を共通プロシジャである データ取り込み でやっているということです。 で、繰り返しになりますが、Test1、Test2、データ取り込み の3つのマクロが、同じ標準モジュールにあろうと 別の標準モジュールにあろうと、それは、家の中で リビングに家具を置くか、寝室におくかということだけの違いで 処理そのものにとっては、関係のないことになります。 (β) 2015/10/30(金) 13:15 ---- 今までのコメントは、関連のマクロを【標準モジュール】に記述してあるということを前提にしています。 【シートモジュール】に記述している場合は、ちょっとだけ説明がかわってくるんですが。 実際は、どこにコードを記述していますか? (β) 2015/10/30(金) 14:14 ---- > で、繰り返しになりますが、Test1、Test2、データ取り込み の3つのマクロが、同じ標準モジュールにあろうと > 別の標準モジュールにあろうと、それは、家の中で リビングに家具を置くか、寝室におくかということだけの違いで > 処理そのものにとっては、関係のないことになります。 なんとなく理解出来てきました! > 実際は、どこにコードを記述していますか? どこに書くのかちょっと解ってなかったので、最初に色々調べていたところ、標準モジュールを挿入して書く、というものを見つけたので、標準モジュールにそれぞれ名前を付けて置いています (Lila) 2015/10/30(金) 15:28 ---- >>標準モジュールにそれぞれ名前を付けて置いています それはいいことだと思います。 (β) 2015/10/30(金) 16:41 ---- お世話になっています。 今回、このモジュールを動かしていて、何故か計算が出来ない部分があったので、再度質問させていただきに参りました。 月数が変わり、2014/12〜2015/11までで使用しており、今の所確認済みで、計算が反映できていないのが、「BA〜BL」の12列での事なのですが、これはまだ数値が入っているのが「2015/10」と「2015/11」(BK〜BL列)になっているので、もしかしたらBA列の「2014/12」でデータがないので次の項目(BM列から12列)へ飛んでしまっているのかな?と思ったのですが、実際はどうなのでしょうか・・・? よろしくお願いします。 (Lila) 2015/11/25(水) 13:38 ---- マクロコード的にはこの部分がそうなのかな?と With shB With .UsedRange mCol = .Columns.Count mRow = .Rows.Count End With For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 sv = .Cells(1, j).Value '集約コード .Columns(j).Resize(, 6).Delete .Cells(1, j).Value = sv With .Range(.Cells(5, j), .Cells(mRow, j + 5)) For Each c In .Cells parts = c.EntireRow.Cells(1).Value yyyymm = Format(c.EntireColumn.Cells(2).Value, "yyyymm") n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) If n = 0 Then c.Value = "" Else c.Value = c.Value / n End If Next .NumberFormatLocal = "0.00%" End With Next End With MsgBox "処理が完了しました。" End Sub でも、後ろから12列ごとに処理をしている、という事は、最新月(この場合だとBL列)で計算が出来ていないのはおかしい・・・??のかな??と・・・ (Lila) 2015/11/25(水) 14:15 ---- 例によってすっかり忘却の彼方です。 いくつか処理があったわけですが、分割とか故障率とか・・・ アップされたコードを見る限り、故障率? BA〜BL がおかしくなっているということは 集計コードが少なくとも4つ以上 Bブックにあるということですね。 そのときの BA〜BL に対する集計コードと月、この組み合わせの部品情報が CブックやAブックに、ちゃんとあって、でも計算されていないということですか? (β) 2015/11/25(水) 14:24 ---- βさんすいません、いつもありがとうございます; そうですね、故障率の部分になりまして、組み合わせの情報が全てのブックにあり、計算がされていない状態ですね。 他の箇所もざっと確認した所、データ記載があるのにも関わらず、計算されていない箇所がありました。 でも、計算できている部分が多数で、原因がわからずです・・・。 BA〜BL列も含め、計算されていない箇所の全ブック存在確認をもう一度細かくしてみます。 頂いたコードは以下です。 Sub 故障率() Dim shA As Worksheet Dim shB As Worksheet Dim shC As Worksheet Dim c As Range Dim dicA As Object Dim dicC As Object Dim k As Variant Dim mCol As Long Dim mRow As Long Dim j As Long Dim sv As String Dim parts As String Dim yyyymm As String Dim n As Long Dim Sp As Shape Application.ScreenUpdating = False Set shB = ThisWorkbook.Sheets("Sheet2") shB.Cells.Clear ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") '故障部品データベース(★シート名変更箇所) For Each Sp In shB.Shapes Sp.Delete Next Set shA = Workbooks("部品データベース.xlsm").Sheets("Sheet2") '商品別部品使用数(集約表)(★ブック名、シート名変更箇所) Set shC = Workbooks("機種別小分類.xlsx").Sheets("機種別小分類") '稼働台数(★ブック名、シート名変更箇所) Set dicA = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") For Each c In shC.Range("A2", shC.Range("A" & Rows.Count).End(xlUp)) k = Format(c.Value, "yyyymm") & c.Offset(, 1).Value '年月+集約コード dicC(k) = dicC(k) + c.Offset(, 2).Value '稼働台数 Next With shA.Range("A1", shA.UsedRange) With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1) For Each c In .Cells k = c.EntireRow.Cells(1).Value & vbTab & c.EntireColumn.Cells(1).Value '部品番号+集約コード dicA(k) = dicA(k) + c.Value '集約コード内部品数 Next End With End With With shB With .UsedRange mCol = .Columns.Count mRow = .Rows.Count End With For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 sv = .Cells(1, j).Value '集約コード .Columns(j).Resize(, 6).Delete .Cells(1, j).Value = sv With .Range(.Cells(5, j), .Cells(mRow, j + 5)) For Each c In .Cells parts = c.EntireRow.Cells(1).Value yyyymm = Format(c.EntireColumn.Cells(2).Value, "yyyymm") n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) If n = 0 Then c.Value = "" Else c.Value = c.Value / n End If Next .NumberFormatLocal = "0.00%" End With Next End With MsgBox "処理が完了しました。" End Sub (Lila) 2015/11/25(水) 14:41 ---- いままでもありましたが、マッチする【はず】なのに、マッチしない。 コード不備もありましたが、多くは、セルにある値そのものが 「見かけ上にているけど異なる」といったものだったと思います。 サブプロシジャ Function normalize(s As String) As String normalize = WorksheetFunction.Clean(WorksheetFunction.Trim(s)) End Function これを追加しておいて、 故障率プロシジャ内で比較キーをセットしている4か所を以下のように変更すると どうなりますか? k = Format(c.Value, "yyyymm") & c.Offset(, 1).Value '年月+集約コード これを k = Format(c.Value, "yyyymm") & normalize(c.Offset(, 1).Value) '年月+集約コード k = c.EntireRow.Cells(1).Value & vbTab & c.EntireColumn.Cells(1).Value '部品番号+集約コード これを k = normalize(c.EntireRow.Cells(1).Value) & vbTab & normalize(c.EntireColumn.Cells(1).Value) '部品番号+集約コード sv = .Cells(1, j).Value '集約コード これを sv = normalize(.Cells(1, j).Value) '集約コード parts = c.EntireRow.Cells(1).Value これを parts = normalize(c.EntireRow.Cells(1).Value) (β) 2015/11/25(水) 16:48 ---- 追加、変更して実行してみましたが、特に何か変わった様子はなく、出力されていなかった箇所の出力もされていないようです。 データ的には、当然ですがBブックにあるものは、Aブック(部品番号)、Cブック(稼働台数)にもありました。 BブックのSheet1を作成段階で使用する、故障部品交換リストにも当然ですがデータはありました。(こちらを部品番号と日付で紐付け転記している為)リストにはあるけれど、Bブックの方には品番がない、というものも数点ありましたが、この辺りはBブック基点でのマクロになるので関係ないのかなと思っていますが・・・ (Lila) 2015/11/25(水) 17:16 ---- そうですかぁ・・・・ >>この辺りはBブック基点でのマクロになるので関係ないのかなと思っていますが・ はい、Bブック基点ですから、関係ないですね。 こちらでも、いろいろ調べてみます。 (β) 2015/11/25(水) 17:25 ---- とりあえず報告します。 BブックのデータをBL列までに、集約コードを増やしたものにして、(Lila) 2015/11/25(水) 14:41 でアップされたコードを実行。 結果は、全く計算されず(マッチせず)空白。 で、こちらに保存している、こちらの最新コードで実行すると、正しく結果が計算され転記されました。 同じデータを相手にしているわけですから、コードが、どこか違うということですね。 ちょっと、そちらのコードと、こちらのコードをつきあわせてみます。 (β) 2015/11/25(水) 17:59 ---- コード、1か所、違い発見。 下のほうにあるコード こちら yyyymm = Format(c.EntireColumn.Cells(3).Value, "yyyymm") そちら yyyymm = Format(c.EntireColumn.Cells(2).Value, "yyyymm") Bブックの日付行ですが、3行目じゃなかったですか? なぜ、そちらのコードは2行目になっているんでしょう? (β) 2015/11/25(水) 19:30 ---- おはようございます。 確か3行目にしたのは、一度レイアウトを変更しようとした時のものだったかと思います。 なので、日付列は2行目ですね。 確認なのですが、サブプロシジャを別に置くか、コードの一番上に置いて、そのほかの該当コードを書き換えれば良いのですよね?? (Lila) 2015/11/26(木) 08:25 ---- いったん、いろいろ書きこみましたが、こちらでの確認間違いもあったのでいったん消去しました。 Bブックの日付を2行目に変更して、そちらのコードを実行しました。 当方では、きちんと計算されて SHeet2 に %表示されています。 ですから、データが、コードの合わないということなんでしょうねぇ?? >>サブプロシジャを別に置くか、コードの一番上に置いて、そのほかの該当コードを書き換えれば良いのですよね?? はい。一度、そうして試してみてください。 (β) 2015/11/26(木) 08:48 ---- もう一度ちゃんと確認しつつ実行してみたら、結果がSheet2に出ました! いつも、本当にありがとうございます^^! (Lila) 2015/11/26(木) 08:57 ---- いつもありがとうございます。 以前こちらの質問で、βさんに頂いた以下のコードなのですが、12ヶ月のデータを6ヶ月分のみ計算する、というものでした。 ですが、今回12ヶ月のものも必要になり、6ヶ月分をデリートする、という箇所をコメント表示にしました。 表示は12ヶ月になったのですが、計算の方が前半の半年分しか計算されない、という状態になってしまいました。 数値の箇所は、シートの列や行の事を指していると思っているのですが、違うのでしょうか・・・? 度々申し訳ありませんが、ご教示のほどよろしくお願い致します。 【VBAコード】 Sub 故障率3() Dim shA As Worksheet Dim shB As Worksheet Dim shC As Worksheet Dim c As Range Dim dicA As Object Dim dicC As Object Dim k As Variant Dim mCol As Long Dim mRow As Long Dim j As Long Dim sv As String Dim parts As String Dim yyyymm As String Dim n As Long Dim Sp As Shape Application.ScreenUpdating = False Set shB = ThisWorkbook.Sheets("Sheet2") shB.Cells.Clear ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") '故障部品データベース(★シート名変更箇所) For Each Sp In shB.Shapes Sp.Delete Next Set shA = Workbooks("部品データベース.xlsm").Sheets("Sheet2") '商品別部品使用数(集約表)(★ブック名、シート名変更箇所) Set shC = Workbooks("30-21 MTBF 機種別小分類.xlsx").Sheets("_30_21_MTBF_機種別小分類") '稼働台数(★ブック名、シート名変更箇所) Set dicA = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") For Each c In shC.Range("A2", shC.Range("A" & Rows.Count).End(xlUp)) k = Format(c.Value, "yyyymm") & normalize(c.Offset(, 1).Value) '年月+集約コード dicC(k) = dicC(k) + c.Offset(, 2).Value '稼働台数 Next With shA.Range("A1", shA.UsedRange) With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1) For Each c In .Cells k = normalize(c.EntireRow.Cells(1).Value) & vbTab & normalize(c.EntireColumn.Cells(1).Value) '部品番号+集約コード dicA(k) = dicA(k) + c.Value '集約コード内部品数 Next End With End With With shB With .UsedRange mCol = .Columns.Count mRow = .Rows.Count End With For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 sv = normalize(.Cells(1, j).Value) '集約コード '.Columns(j).Resize(, 6).Delete .Cells(1, j).Value = sv With .Range(.Cells(5, j), .Cells(mRow, j + 5)) For Each c In .Cells parts = normalize(c.EntireRow.Cells(1).Value) yyyymm = Format(c.EntireColumn.Cells(2).Value, "yyyymm") n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) If n = 0 Then c.Value = "" Else c.Value = c.Value / n End If Next .NumberFormatLocal = "0.00%" End With .AutoFilterMode = False '念のためにオートフィルター解除 .UsedRange.Offset(3).AutoFilter End With MsgBox "処理が完了しました。" End Sub (Lila) 2016/03/03(木) 13:42 ---- 懐かしいコードですね。一応、そちらで使っていただいていたようで作者としてはうれしい限りですが すっかり忘却の彼方の、そのまた彼方です。 思い出せるかどうか、不安ですけど、ちょっとコードを追いかけてみます。 実際に動かせば解決は早いのでしょうけど、ブック等の環境も、もうすっかり消去しているので。 ところで、アップされた故障率3、ちょっとへんじゃないですか? For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 この For にあたる Next が見当たらないですね? それと、このとぴそのものが、長いというか文字数が大きくなっているので、たとえば編集等の操作ができなくなっていると思います。 このとぴを参照した形で、続編の新しいとぴを立ち上げられてはいかがでしょう。 (β) 2016/03/03(木) 16:57 ---- 長引くようであれば、↑でお願いした新しいトピでお願いしたいのですが、 With .Range(.Cells(5, j), .Cells(mRow, j + 5)) その前の '.Columns(j).Resize(, 6).Delete は、6か月分に縮小しているところで、そこはコメントアウトして削除スキップしていますが この With でくくった領域、6か月分だけですね。 With .Range(.Cells(5, j), .Cells(mRow, j + 11)) にすると、どうなりますか? (β) 2016/03/03(木) 17:09 ---- >βさん > 懐かしいコードですね。一応、そちらで使っていただいていたようで作者としてはうれしい限りですが 大変重宝しております>< ありがとうございます。 NEXTは、UPした時に消してしまったのか、確かに無いですね^^; でも、実際のブックの方にはちゃんとあるので、大丈夫です! > With .Range(.Cells(5, j), .Cells(mRow, j + 11)) 此処の数値は行の事ではなく、列の方だったのですね! ありがとうございます^o^* 解決できました! (Lila) 2016/03/04(金) 08:48 ...
-
http://www.excel.studio-kazu.jp/wiki/kazuwiki/201510/20151022153817.txt
- [detail]
- similar
PREV
NEXT
Powered by
Hyper Estraier 1.4.13, with 97040 documents and 608045 words.
訪問者:![カウンタ](../../cgi-bin/cnt/logcnt5.cgi?id=hyper)
![Valid HTML 4.01 Transitional](https://www.w3.org/Icons/valid-html401)