違う図面番号に同じ工種番号があれば重複してない工種番号を各図面番号に加えるには?
Question 60.1 Previous Next
Excel2002を使用しています。
A列に同じ工事番号(001が複数、002が複数・・・)、B列に工種番号(050101・・・)、C列に図面番号(1・2・3・・・)があります。 まず最初に同じ工事番号を抽出します。図面番号がちがっても工種番号が同じのがあります。
仮に下記のようだとします。
処理前のシート 処理後のシート というように、違う図面番号に同じ工種番号がある場合、重複してない工種番号をそれぞれの図面番号に加えます。

処理前の図面1と3は同じ工種番号はないですが、図面2の工種番号がそれぞれ1と2で重複するので、図面1と3にそれぞれ工種番号を加えなければなりません。

これを自動で行うことはできないでしょうか。データの切り出しを行って違うシートに貼り付けしまた返してくるマクロだといいと思うのですが・・・。

専門用語だとわかりにくいので、車に例えて説明します。
処理前のシート A列をメーカー名(トヨタ、ホンダ、ニッサン他)、 B列をカラーバリエーション(白、黒、赤他)、 C列を車種(カローラ、シビック、サニー他)とし、入力データが左図のようになったとします。
(黄緑色セルは回答の都合上付加しました・・後述)
共通要素として、ホンダの白に フィットと シビックがあります。そこで処理としては
ホンダ:白:フィット、ホンダ:黒:フィット、ホンダ:白:シビック、ホンダ:黒:シビックとなり、ホンダ:黒:フィット が追加されます。
同様にホンダの黒でフィット、シビック、アコードが共通になり、
 
ホンダ:白:フィット、 ホンダ:黒:フィット、 ホンダ:赤:フィット、
 ホンダ:白:シビック、ホンダ:黒:シビック、ホンダ:赤:シビック、
 ホンダ:白:アコード、ホンダ:黒:アコード、ホンダ:赤:アコード、
となります。 その結果、最終的には、
 
ホンダ:黒:フィット、ホンダ:赤:フィット、ホンダ:赤:シビック、ホンダ:白:アコード、
が追加される形になります。
トヨタ:白:カローラ は、白で共通ですが、ホンダではないので、上記の処理には加わりません。
カラーバリーエーションってたくさんありますよね。ですが、実際の車では、車種ごとにカラーは限定されてます。ですから、仮に、フィットには白色しかなくても、他の色も選べるよってことになってしまうのです。(本来は選べないのに、この辺が矛盾ですが) これでわかるでしょうか。
Answer   Copyright (C) 2003.5.20 永井善王
難解ですね。親亀の背中に小亀・・・、頭が痛くなりそうです。
入力データの黄緑色セルの内の D列は私が付加しました。理由は、ピボットテーブルで集計するために必要で、「フラグ」とでも思っておいてください。同じく 8行目のデータも付加しましたが、他の 6件のデータと無関係のデータがないと、処理の正確性を検証できないからです。
ヒポットテーブル
さっそく回答に入ります。
最初に Excelの通常操作で、データが入力されているワークシートから、右図のピボットテーブルを作成しておきます。(回答が長くなるので説明は省略)

このピボットテーブルで、黒は アコードと シビック、白は シビックと フィットにあることが分かります。

あなたなら、これを見ただけで、どれとどれを絡ませればよいのか直ちに判断できるでしょうが、マクロ
「仕上」シートで行うのは相当むつかしいことのように思います。もしかして専門的な手法が あるのかも知れませんが私は門外漢なので、あなたの説明に沿ってマクロを組んでみました。右下図はそのマクロの実行結果です。 少々長いマクロなので、個々のサブマクロを省略してメインとなるマクロだけを以下に掲載しておきます。
'------------------------------------------------------
Sub ピボットテーブルが更新されたら車名別に色を展開する()
    Sheets("仕上").Select
        Cells.Clear
    ピボットテーブルのデータをコピーして分析シートに貼り付ける
    If Worksheets("分析").Range("A65536").End(xlUp).Row > 4 Then '2車名以上
        分析シートの横計の列を削除し縦計が2以上の列番号を取得する
        分析シートの不要な行を削除する
        For 取出カウンタ = 1 To 格納カウンタ - 1
            分析シートの取出対象列の行を抽出する
            抽出したデータを加工シートに貼り付けて縦計を計算する
            加工シートの縦計が1以上の列の各行のflgを1にする
            分析シートの対応車名を加工シートで仕上がったデータで置換する
        Next
        加工シートのデータを仕上シートへ展開する
    End If
    Application.CutCopyMode = False
    Worksheets("仕上").Activate
    Range("A1").Select
End Sub
'------------------------------------------------------------------------------
これだけでは意味が分かりませんので、 サンプルブック (YNxv98c9.xls 75KB)を ダウンロード して、試してみてください。
マクロの実行方法は、「ピボット」シートの B1セルにあるドロップダウン矢印をクリックして「ホンダ」を選択するだけです。動作確認されたら是非結果をお知らせください。そして、マクロを根気よく解析してください。

 

Excel VBA Macro