入力されたコードでAシートとCシートを検索して情報をコピーしDシートを作成するには?
Question 101.2 Previous Next
*はじめまして。 私はシステムエンジニアをやっているものです。 自分はJavaがメインなんですが、会社の方針でVB&ASPしかさわれません。せっかく覚えてきたJavaが忘れていく・・・泣   雑談で申し訳ありません。
さて、質問です。 「
キーが一致するデータを抽出して別のシートに作成するには?」のページに、カラムに抽出するプログラムがありますが、これと似たようなプログラムをしています。

こちらは、入力値(コード)でデータリストの同値を探し見つけて行位置と分類名を取得し、分類名はCシートから、その分類名の項目列をDシートへ抽出します。 行位置は、Aシートの行ごとの項目列をDシートへ抽出します。
詳細はエクセルファイルにあります。 このメールに添付しましたので、ご覧ください。

 Aシート                    Dシート(抽出結果のレイアウト)
Aシート Dシート 作業手順
(1) 列指定「コード」で、入力値「ABC-122」がAシートの「コード」の同値を探しに行く

(2) 同値を複数に見つけ出し、その行ごとの項目列(すべて)をDシートへ抽出する … (注1)

(3) (2)で取得した行の分類名がCシートの分類名を探して見つけ出し、Dシートへ抽出する … (注2)
 Cシート
Cシート

(注1) …
Dシート.Cells(j + ?, 2) = Aシート.Cells(i, j)
(注2) … 行(i)ループで …
b = Cシート.Cells(i, 1).Row
              Dシート.Cells(j + ?, 1) = Cシート.Cells(???, j)


私がつまづいているのは、行位置を複数に取得したのをカラム抽出のループに代入するところですが、変なレイアウトになってしまいます。ループ代入が間違ってるのか、ずれている感じです。
特に、Cシートから取得して抽出するところが難しい。Aシートのコードで取得した行の分類名で、Cシートの分類名を探し見つけて、行位置を取得する。そこで、カラム(j)ループに代入するプログラムです。3カ所の ? のところが不明です。 よろしくお願いします。
Answer   Copyright (C) 2010.4.11 永井善王
貴方は気付かれなかったようですが 「質問の仕方」 のページでご案内のとおり、Eメールでのご質問はお断りしています。 (ウイルス対策のため即削除する場合あり)
SEさんである貴方には 「釈迦の耳に念仏」 かも知れませんが、知らない人からのEメールは開いてはいけない というのが、一般の常識ではないでしょうか。 (添付ファイル付きなら尚更)
ですが、
[第101回・カウンター570万ヒット達成記念]質問受け付け中 でしたので、一応、回答させていただきます。 今後は正規の質問窓口から行ってください。

ご質問文でいろいろとご説明いただいていますのに、大変申し訳ありませんが十分理解できていません。同じ情報がAシートとCシートに存在するようですがどう使い分けるのか、コードの一部が示されていますが前後の関係が分からない等で、3カ所の ? のところをズバリ回答することは難しいです。
従って、下記にお示したサンプルマクロを解読してヒントにし、ご自分で答えを見つけてください。
Sub 入力されたコードでAシートとCシートを検索して情報をコピーしDシートを作成する()
    コード = "ABC-122"                          '本来はBシートへ入力された値
    Worksheets("D").Activate
    With Worksheets("A")                        'Aシートについて
        列 = 2                                  'Dシート貼り付け開始列
        A下端行 = .Range("C" & Rows.Count).End(xlUp).Row 'AシートC列の下端行を取得
        C下端行 = Worksheets("C").Range("A" & Rows.Count).End(xlUp).Row
        For 行A = 2 To A下端行
            If .Range("C" & 行A).Value = コード Then
                .Range("A" & 行A & ":G" & 行A).Copy
                Range(Cells(1, 列), Cells(1, 列)).PasteSpecial _
                    Paste:=xlPasteValues, Transpose:=True
                分類名 = .Range("A" & 行A).Value
                For 行C = 2 To C下端行
                    If Worksheets("C").Range("A" & 行C).Value = 分類名 Then
                        Worksheets("C").Range("H" & 行C & ":Q" & 行C).Copy
                        Range(Cells(8, 列), Cells(8, 列)).PasteSpecial _
                            Paste:=xlPasteValues, Transpose:=True
                    End If
                Next
                列 = 列 + 1
            End If
        Next
    End With
    Range("A1").Select
End Sub
なお、このマクロは入力されたコードや分類名がAシート・Cシートに必ず存在する前提とか、安全対策などを行っていませんから補強するなどして、上手くできたらご連絡ください。 ガンバ!

サンプルブックのダウンロードは
ここをクリック (YNxv98691.xls 76KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。

 

Excel VBA Macro