【エクセル】条件に合うデータ抽出後別シートに

同じような質問かも知れませんが、応用ができず、なかなか解決しないので、教えてください。

エクセルについて条件と一致するデータがある場合、指定したセルの表示を別シートに返したい場合

例
表1：
A　　　　　B　　　　　C　　　　　D　　　　　E　　　　　F　　　　　D　　　　　G
ばなな　　　2　　　　　4　　　　　6　　　　　8　　　　　10　　　　12　　　　　13
りんご　　　3　　　　　8　　　　　12　　　　 15　　　　 20　　　　25　　　　　30
すもも　　　3　　　　　9　　　　　10　　　　 12　　　　 20　　　　21　　　　

の時
表2
A　　　　　B　　　　　C　　　　　D　　　　　E　　　　　F　　　　　D　　　　　G
1　　　　　2　　　　　4　　　　　6　　　　　 8　　　　 15　　　　 20　　　　 21
　　　　　ばなな　　 ばなな　　　ばなな　　　ばなな　　りんご　　　りんご　　　すもも
　　　　　　　　　　　　　　　　　　　　　　 りんご　　　　　　　　すもも

のように列1の数値に一致する数値が表1のB～Gまでにある場合、Aの数値を表2に表示させたい場合
どのような関数を使えばよいでしょうか？関数以外でも解決できる方法があれば教えて下さい。

No.4 回答者： WindFaller 回答日時： 2015/03/22 20:54

こんばんは。

こういう展開作業のことを、なんとかって言ったような気がします。
純粋なマクロでとも考えたのですが、なかなか面倒になってしまうので、一部関数混じりです。
フォームコントロールにて、標準モジュールに貼り付けお使いください。
なお、範囲などの登録やシートの登録というところは、Sheet2 でしたら、そのままでよいです。
一応、マクロのコード上には、注意点など書かれていますので、ざっと目を通してください。


'//
Sub NumbersSort()
　Dim i As Long, j As Long, k As Long
　Dim Ar(), Arbuf As Variant
　Dim buf As String
　Dim Rng As Range
　Dim c As Range
　Dim myDic As Object
　Set myDic = CreateObject("Scripting.Dictionary")
　　
　Dim Ws2 As Worksheet
　Set Ws2 = Worksheets("Sheet2") 'シートの登録
　
　Set Rng = ActiveSheet.Range("A1").CurrentRegion　'範囲の自動取得
　 'Set Rng = Range("B1:H3") '範囲の登録 (上か下かどちらか一方）
　
　'注意：シート2の関連消去
　Ws2.Range("A1").CurrentRegion.ClearContents
　　
　j = Rng.Count
　If j = 0 Then Exit Sub
　'------データの取得----------
　For Each c In Rng　　'データの範囲
　　If IsNumeric(c.Value) Then
　　　If myDic.Exists(c.Value) Then
　　　　buf = myDic.Item(c.Value)
　　　　myDic.Item(c.Value) = buf & "," & Rows(c.Row).Cells(1).Value
　　　Else
　　　　myDic.Add c.Value, Rows(c.Row).Cells(1).Value
　　　　k = k + 1
　　　　ReDim Preserve Ar(k)
　　　　Ar(k) = c.Value
　　　End If
　　　buf = ""
　　End If
　Next
　'-----ナンバリング---------
　For i = 1 To k
　　Ws2.Cells(1, i).Value = Application.Small(Ar, i)
　Next i
　
　'--------出力------------
　For i = 1 To Ws2.Cells(1, Columns.Count).End(xlToLeft).Column
　　　　buf = myDic.Item(Ws2.Cells(1, i).Value)
　　　If buf <> "" Then
　　　　Arbuf = Application.Transpose(Split(buf, ","))
　　　　j = UBound(Arbuf)
　　　　Ws2.Cells(2, i).Resize(j).Value = Arbuf
　　　End If
　Next i
End Sub
'//

この回答へのお礼

ありがとうございます！高度過ぎて内容は理解できませんでしたが、大変参考になりました！

お礼日時：2015/03/23 17:28

No.3 ベストアンサー 回答者： mike_g 回答日時： 2015/03/21 15:54

添付図参照

Sheet1 において、
１．範囲 A1:H3 を選択
２．[挿入]→[名前]→[作成]を実行
３．“左端列”のみにチェック入れ
４．[OK]をパシーッ
Sheet2 において、
５．セル A2 に次式を入力して、此れを右および下方にズズーッとドラッグ＆ペースト
　　　=IF(MATCH(A$1,INDIRECT(Sheet1!$A1),0),Sheet1!$A1)
６．列Ａ～Ｈ全体を選択
７．[編集]→[ジャンプ]→[セル選択]を実行
８．“数式”に目玉を入れ、かつ、その配下の“エラー値”のみにチェック入れ
９．[OK]をパシーッ（→その結果を添付図 Sheet2 の上段に示した）
10．[編集]→[削除]を実行
11．“上方向にシフト”に目玉入れ
12．[OK]をパシーッ（→その結果を添付図 Sheet2 の下段に示した）

この回答へのお礼

初心者の為、説明が分かりにくかったのに、教えていただいてありがとうございました。皆さんとてもすばらしい回答いただきましたが、一番早くに解決していただいたので、こちらの方をベストアンサーにさせていただきます。

お礼日時：2015/03/23 17:32

No.2 回答者： mike_g 回答日時： 2015/03/21 14:53

それから…

表1、2 の上端の記号が「A B C D E F G H」でなく、「A B C D E F D G」となっている（F とG の間に再び D が登場！）のはなぜ？
コレって列記号ではないの～？

No.1 回答者： mike_g 回答日時： 2015/03/20 21:57

》 …のように列1の数値に一致する数値が…

「列1」とは「表１」あるいは「表２」のどの部分を指していますか？
普通は列Ａ、列Ｂとか行１、行２と言いますけど。