エクセル 関数 条件にあったセルを表示したい

質問

エクセル関数で困っています。
下記のような表があります。商品コードに一致する顧客コードを表示させたいのですが....　何か良い方法がありますでしょうか？

【表１】
顧客コード　　商品コード１　商品コード２　商品コード３　..６まであります。
０５８２４　　　　Ａ１２５００　　Ｂ０５０４０　　Ａ２５０１２
０２５７２　　　　Ｂ０５０４０　　Ｃ１２５００
０７０５０　　
０３０５８　　　　Ｃ１２５００　　Ｂ０５０４０

【表２】
商品コード　　　顧客コード
Ｂ０５０４０　　０５８２４
　　　　　　　　　０２５７２
　　　　　　　　　０３０５８
Ｃ１２５００　　０２５７２
　　　　　　　　　０３０５８
Ａ１２５００　　０５８２４
Ａ２５０１２　　０５８２４

【表１】の顧客コードと商品コードは別表からVLOOKUPで一定の条件を満たしたものを抽出しています。顧客コードは重複するものはありません。
商品コードは数が多いため、【表１】に表示されている商品コードのみを使って【表２】のように該当する顧客が多い商品コード順に並べ替え
して、該当する顧客コードを表示させたいのですが可能でしょうか？
説明不十分な点があるかと思いますがどうぞ宜しくお願いします。

回答No.6

web2525 · ベストアンサー

No4マクロに不備がありました
少し修正

Sub test()
Application.ScreenUpdating = False
Dim aa, bb As Range
Set aa = Worksheets(1).Range("A2")
Set bb = Worksheets(2).Range("A2")
bb.Offset(-1) = "商品コード"
bb.Offset(-1, 1) = "顧客コード"
While aa <> ""
lp2 = 0
For lp = 0 To 5
If aa.Offset(0, lp + 1) <> "" Then
bb.Offset(lp2).Value = aa.Offset(0, lp + 1)
bb.Offset(lp2, 1).Value = aa.Value
bb.Offset(lp2, 2).Value = "=COUNTIF(A:A," & bb.Offset(lp2).Address & ")"
lp2 = lp2 + 1
End If
Next
Set bb = bb.Offset(lp2)
Set aa = aa.Offset(1)
Wend
Worksheets(2).Select
Columns("A:C").Sort Key1:=Range("C2"), Order1:=xlDescending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
xlSortNormal, DataOption2:=xlSortNormal
Columns("C:C").ClearContents
Range("A2").Select
While ActiveCell <> ""
With ActiveCell
lp = 0
While .Value = .Offset(lp)
lp = lp + 1
Wend
If .Value = .Offset(1) Then
Range(.Offset(1).Address & ":" & .Offset(lp - 1).Address).Clear
End If
.Offset(lp).Select
End With
Wend
Application.ScreenUpdating = True
End Sub

お礼

web2525様
本当に、本当にありがとうございます。
早速試したところ、見事に望んでいた結果が得られました!!!
スゴイです、感動です。
EXCELって奥深いですね。
次回また質問があった場合にはぜひご指導いただきたいので
どうぞよろしくお願いします。

回答No.5

noname#204879

Sheet1
　　 A　　　B　　　 C　　　 D　　　 E　　　 F　　　 G
1　Ccode　Pcode1　Pcode2　Pcode3　Pcode4　Pcode5　Pcode6
2　05824　A12500　B05040　A25012
3　02572　B05040　C12500
4　07050
5　03058　C12500　B05040
6

以下は Sheet2 における操作です。

１．次の各セルに該当する式を入力して、此れを下方にズズーッとドラ
　　ッグ＆ペースト（その結果を Fig-1 に示した）
　　A2: =OFFSET(Sheet1!$A$1,1+INT((ROW(A1)-1)/6),IF(MOD(ROW(A1),6),MOD(ROW(A1),6),6))
　　B2: =OFFSET(Sheet1!$A$1,1+INT((ROW(A1)-1)/6),)
　　C2: =COUNTIF(A:A,A2)

２．範囲 A1:C1 を選択して[オートフィルタ]を実行
３．セル A1 のオートフィルタ矢印(▼)をクリックして“(オプショ
　　ン)”を選択
４．左上ボックスに 0 を入力して、その右のボックスで“と等しくな
　　い”を選択して[OK]をクリック
５．抽出されたデータ上の任意のセルを選択して[可視セルの選択]→
　　[コピー]を実行
６．セル E1 を選択して[貼り付け]を実行（その結果を Fig-2 に示し
　　た）
７．範囲 E2:G8 を選択して、次の条件で[並べ替え]（その結果を
　　Fig-3 に示した）
　　　[最優先されるキー]　　　 列Ｇ　降順
　　　[2番目に優先されるキー]　列Ｅ　昇順
８．範囲 E2:E8 を選択（アクティブセルは E2）して、次の[条件付き
　　書式]を設定（その結果を Fig-4 に示した）
　　　数式が　　　=E2=E1
　　　フォント色　白
９．Ａ～Ｄ列およびＧ列を削除

Fig-1　　　　　　　　　　　　　Fig-2
　　　A　　　 B　　 C　　　　　　　 E　　　 F　　 G
1　 Pcode　 Ccode　Qnty　　　　1　Pcode　 Ccode　Qnty
2　 A12500　05824　　 1　　　　2　A12500　05824　　 1
3　 B05040　05824　　 3　　　　3　B05040　05824　　 3
4　 A25012　05824　　 1　　　　4　A25012　05824　　 1
5　　　　0　05824　　18　　　　5　B05040　02572　　 3
6　　　　0　05824　　18　　　　6　C12500　02572　　 2
7　　　　0　05824　　18　　　　7　C12500　03058　　 2
8　 B05040　02572　　 3　　　　8　B05040　03058　　 3
9　 C12500　02572　　 2
10　　　 0　02572　　18　　　　Fig-3
…　　　…　……　　 …　　　　　　 E　　　 F　　　G
13　　　 0　02572　　18　　　　1　Pcode　 Ccode　Qnty
14　　　 0　07050　　18　　　　2　B05040　05824　　 3
…　　　…　……　　 …　　　　3　B05040　02572　　 3
19　　　 0　07050　　18　　　　4　B05040　03058　　 3
20　C12500　03058　　 2　　　　5　C12500　02572　　 2
21　B05040　03058　　 3　　　　6　C12500　03058　　 2
22　　　 0　03058　　18　　　　7　A12500　05824　　 1
…　　　…　……　　 …　　　　8　A25012　05824　　 1
25　　　 0　03058　　18
26　　　 0　00000　　18

　　　　　　　　Fig-4
　　　　　　　　　　 E　　　 F　　　G
　　　　　　　　1　Pcode　 Ccode　Qnty
　　　　　　　　2　B05040　05824　　 3
　　　　　　　　3　　　　　02572　　 3
　　　　　　　　4　　　　　03058　　 3
　　　　　　　　5　C12500　02572　　 2
　　　　　　　　6　　　　　03058　　 2
　　　　　　　　7　A12500　05824　　 1
　　　　　　　　8　A25012　05824　　 1

お礼

回答いただきありがとうございます。
オートフィルタが使えない方も使用するため、関数などで自動的に表示
できる方法を模索していました。
しかしこのような方法もあるのですね、勉強になります。
丁寧なご説明ありがとうございます。

回答No.4

web2525

一応マクロも作ってみたけど、動作は怪しいかも
シート１の表１が有ってシート２に表２作成です

Sub narabikae()
Application.ScreenUpdating = False
Dim aa, bb As Range
Set aa = Worksheets(1).Range("A2")
Set bb = Worksheets(2).Range("A2")
bb.Offset(-1) = "商品コード"
bb.Offset(-1, 1) = "顧客コード"
While aa <> ""
For lp = 0 To 5
If aa.Offset(0, lp + 1) = "" Then
Set bb = bb.Offset(lp)
lp = 5
Else
bb.Offset(lp).Value = aa.Offset(0, lp + 1)
bb.Offset(lp, 1).Value = aa.Value
bb.Offset(lp, 2).Value = "=COUNTIF(A:A," & bb.Offset(lp).Address & ")"
End If
Next
Set aa = aa.Offset(1)
Wend
Columns("A:C").Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Columns("C:C").ClearContents
Worksheets(2).Range("A2").Select
While ActiveCell <> ""
With ActiveCell
lp = 0
While .Value = .Offset(lp)
lp = lp + 1
Wend
If .Value = .Offset(1) Then
Range(.Offset(1).Address & ":" & .Offset(lp - 1).Address).Clear
End If
.Offset(lp).Select
End With
Wend
Application.ScreenUpdating = True
End Sub

お礼

web2525さん、いいえweb2525サマ
マクロまで作って頂き、本当にありがとうございます。
マクロは殆ど使ったことがない私ですが今からチャレンジします！
結果はお知らせいたしますので、少々？お待ちください。

回答No.3

orangezzzz

こんばんは。#1です。
関数だけでは無理ですね。
マクロも必要でしょう。
一番よいのはAccessにすることですが。

お礼

再度の回答ありがとうございます。
一番よいのはAccessにすることですが。
↑↑ですよねぇ^^;
でも、Accessのない環境＋Excelの達人ではない私
といった状況なので.．。
Accessの導入は再三お願いしている状況であります。

回答No.2

web2525

関数で一発抽出は計算式文字数制限に引っかかり出来ませんでした

で、代案として
表２の商品コード列（A列と仮定)
A2に
=INDEX(表1!商品コード範囲,ROUNDUP((ROW()-1)/6,0),MOD(ROW()-2,6)+1)

顧客コード列（B列と仮定)
B2に
=INDEX(表1!顧客コード範囲,ROUNDUP((ROW()-1)/6,0))

C2に
=IF(A2=0,"",COUNTIF(A:A,A2))
として下方向コピー

結果をコピーし別表に値のみ貼り付け、C列を基準に降順でソート、不要な部分を削除

これでお望みの表に近い形に。

後はマクロでやるしかないのでは？

お礼

web2525さん
前回の質問に続き、ご回答いただきありがとうございます。
関数を駆使してなんとか理想の形にもっていこうと苦戦していたので、代案の提案大変ありがたいです。

後はマクロでやるしかないのでは？
とのことですがそうではないかと思い始めたところで質問させて頂いた次第です。
マクロもやはり勉強すべきなのですね。関数には限界があるということを痛感しました。

回答No.1

orangezzzz

こんばんは。
ピボットテーブルという発想はありませんか。

お礼

早速の回答ありがとうございます。　
しかしながら、関数のみで処理したいのです。
【表１】は入力専用のシートから抽出していてさらに【表２】も
別の表に関数で抽出する仕組みになっています。
説明不足でしたすみません(T_T)