表の中から条件に合う値を複数検索する方法（Excel又はAccess）

質問

Excel、Accessのいずれでも構いません。
＜表１＞のシート（テーブル）があった場合に、＜表２＞のように担当者ごとの取引先を検索してきて複数の値を列記する方法を教えてください。
クエリや関数式など、どのような方法でも結構です。

＜表１＞
取引先　 担当者
Ａ社　　　佐藤
Ｂ社　　　佐藤
Ｃ社　　　田中
Ｄ社　　　佐藤
Ｅ社　　　村井
Ｆ社　　　村井
Ｇ社　　　田中
・　　　 ・
・ 　　　 ・
・ 　　　 ・

＜表２＞
担当者　　取引先
佐藤　　Ａ社　Ｂ社　Ｄ社
田中　　Ｃ社　Ｇ社
村井　　Ｅ社　Ｆ社
　・　　　・
　・　　　・
　・　　　・

やりたことは、差し込み印刷で各「担当者」に、それぞれが担当する「取引先」を通知する文書を作成することです。
「取引先」は、同じセルになっても構いませんし、もちろん違っていても構いません。
よろしくお願いします。

回答No.3

BLUEPIXY · ベストアンサー

>しかし、正直言ってよく分かりません。
どういう部分がわからないのでしょうか・・
表１というシートのＡ１のセルから質問文のようなデータが並んでいて
表２というシートにＡ１のセルから質問文のようなデータに転記します。
ＡＬＴ＋Ｆ１１キーでＶＢＥを起動し
ThisWorkbook をダブルクリックして貼り付けます。
シートからマクロの実行で選んで実行します。

お礼

上手くいきました。
ご丁寧なご回答をいただき、ありがとうございました。

回答No.4

nicotinism

Access2002で試しました。
表１をTBL1（テーブル名）とすると
新規クエリを作成し（クエリ1）
そのSQLビューに

SELECT
TBL１.取引先,
TBL１.担当者,
DCount("*","TBL1","取引先<='" & TBL1.取引先 & "' and 担当者='" & TBL1.担当者 & "'") AS 連番
FROM TBL１;

とし、
このクエリ1を元にクロス集計クエリを作ってSQLビューには

TRANSFORM First(クエリ1.取引先) AS 取引先の先頭
SELECT クエリ1.担当者
FROM クエリ1
GROUP BY クエリ1.担当者
PIVOT クエリ1.連番;

でいけるかな～？

お礼

なるほどクエリを元にクロス集計クエリを作るという方法もあるんですね。
参考になりました。ありがとうございます。

回答No.2

keirika

Sheet1のＡ列に取引先、Ｂ列に担当者が入力されていて、Ｄ列とＥ列に表２を作成すると仮定します。

１．まず表１(Ａ列とＢ列)を担当者で並び替えます。

２．以下のマクロを実行します。

Sub test()

Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer

Worksheets("Sheet1").Range("d1").Value = Worksheets("Sheet1").Range("b1").Value

a = 0
b = 0
d = 0
e = 0

Do While Worksheets("Sheet1").Range("b1").Offset(b, 0).Value <> ""
If Worksheets("Sheet1").Range("d1").Offset(d, 0).Value = _
Worksheets("Sheet1").Range("b1").Offset(b, 0).Value Then

Worksheets("Sheet1").Range("e1").Offset(d, e).Value = _
Worksheets("Sheet1").Range("a1").Offset(a, 0).Value

a = a + 1
b = b + 1
e = e + 1
Else
d = d + 1

Worksheets("Sheet1").Range("d1").Offset(d, 0).Value = _
Worksheets("Sheet1").Range("b1").Offset(b, 0).Value

e = 0
End If
Loop

End Sub

EXCEL2003使用

動作確認はしていますが、上手く動かない場合はご容赦ください

お礼

上手くいきました！ありがとうございました。

回答No.1

BLUEPIXY

Public Sub 処理()
Dim base As Range, i As Long
Dim 担当者 As String, 取引先 As String
Dim List, wk
Set List = CreateObject("Scripting.Dictionary")

Set base = Sheets("表１").Range("A2")
i = 0
Do While (base.Offset(i).Value <> "")
取引先 = base.Offset(i).Value
担当者 = base.Offset(i, 1).Value
If Not List.Exists(担当者) Then '始めてでてくる担当者を登録
List.Add 担当者, 取引先
Else '重複する場合、連結する
List.Item(担当者) = List.Item(担当者) & " " & 取引先
End If
i = i + 1
Loop

Sheets("表２").Cells.ClearContents '書き出しシートのクリア
Sheets("表２").Cells(1, 1).Value = "担当者"
Sheets("表２").Cells(1, 2).Value = "取引先"

i = 2
For Each wk In List.keys
Sheets("表２").Cells(i, 1).Value = wk
Sheets("表２").Cells(i, 2).Value = List.Item(wk)
i = i + 1
Next
Set List = Nothing
End Sub

お礼

早速ご返信いただきありがとうございます。
しかし、正直言ってよく分かりません。
もう少し分かりやすいものをご紹介いただければ嬉しいです。
わがまま申し上げてすみません。よろしくお願いします。