[[20080215144955]]　『重複データのみの抽出』（haru）　ページの最後に飛ぶ

『重複データのみの抽出』（haru）

こんにちわ。困ったときはいつも拝見させて頂いています。

今エクセルで所属ごとに数百件の名前を並び替えているのですが、
Ｂ列に同一の名前がある時があります。その名前を抽出して
どことどこに所属しているかが分かる別の一覧表を作りたいのです。
下の表なら、いとうさんとさとうさんの所属だけが必要です。
同所属で名前が重複することはなく、重複していない名前の抽出は
いりません。どうか、教えて下さい。

      A  　　 B   　　C  　　 
　
　1 所属Ａ　いとう　　　　　　　　　いとう　所属Ａ　所属Ｂ　
  2 所属Ａ　おかだ　　　　　　　　　さとう　所属Ａ　所属Ｂ
  3 所属Ａ　さとう
  4 所属Ｂ　あきた　　　　　⇒　　
  5 所属Ｂ　いとう
　6 所属Ｂ　さとう
　7 所属Ｂ　しまだ
　8 所属Ｃ

 こんな感じでどうでしょう。
 D列以降に書き出します。
 D:IV列を消去するコードを入れてありますので、必要に応じて変更してください。
 （コピーしたBookで試されることをお勧めします）
 (ROUGE)
'----
Sub test()
Dim dic As Object, tbl, i As Long, x, ky
tbl = Range("A1").CurrentRegion.Resize(, 2).Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tbl, 1)
    If Not dic.Exists(tbl(i, 2)) Then
        dic.Add tbl(i, 2), Array(False, tbl(i, 1))
    Else
        x = dic(tbl(i, 2))
        x(0) = True
        x(1) = x(1) & "♪" & tbl(i, 1)
        dic(tbl(i, 2)) = x
    End If
Next
i = 0
Range("D:IV").ClearContents
For Each ky In dic.keys
    If dic(ky)(0) Then
        i = i + 1
        x = Split(dic(ky)(1), "♪")
        Range("D" & i).Value = ky
        Range("E" & i).Resize(, UBound(x) + 1).Value = x
    End If
Next
Erase tbl
Set dic = Nothing
End Sub

 実質下記と同じ質問ですね。
 下記を参照ください。
 A,B列が逆で，予め対象が設定されているという
 条件が設定されているだけ，簡単になりますね。

（夕焼）

[[20080213140737]]　>>

 先のコードを本件用に少し編集しました。
 但し，元データ列はA,B逆で作ってあります。（夕焼）

Sub test2()

 lastrow1 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

 lastrow21 = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
  For k = 1 To lastrow1
    For m = 1 To lastrow21
   If Worksheets(2).Cells(m, 1) = Worksheets(1).Cells(k, 1) Then
       lastcolmun = Worksheets(2).Cells(m, Columns.Count).End(xlToLeft).Column
        Worksheets(2).Cells(m, lastcolmun + 1) = Worksheets(1).Cells(k, 2)
    End If
    Next m

    Next k

 End Sub

 ROUGEさんのは質問者さんの希望通りに出来上がっているようですが、
 夕焼けさんのは。。。
 (花粉症は辛い)

 >  質問者さんの希望通りに・・・

 元データ列をA,B逆にして実行しても？でしょうか。

 シート2のA列に，いとう・さとうの記載は必要です。
               （夕焼）

 TOPの質問文を読み直したら，いとう，さとうも自動で
 書き出すということなのでしょうか。
   そうであれば，例示の[[20080213140737]]　とやはり，ほとんど同じですね。
 最後に重複しない行のみ削除していけばOKですね。
 （つまり。C列が空欄であれば，その行を削除するコードを追加） 
 もりろん，元データのA,B列は交換（夕焼）

 夕焼け様
 Ａ列・Ｂ列にあるデータを、Ｂ列の名前をキーに並べていくとした場合、
 例題をシート１に貼り付けても、シート２は何も表示されないのですが、
 これはＯＳ：ＸＰ　Excel：2002の私の環境の問題でしょうか？！

 私の方は、ROUGEさんので解決としておきます。
 (花粉症は辛い)

 (花粉症は辛い)さん
 シート1のA列に人名，B列に所属名を置きます。（A,B逆ということです。）
 そして，シート2のA列に希望の名前を書いておきます。
 そこからスタートするのが，上のコードです。

 同様に，シート2に名前も自動で書き出すのが，例示の[[20080213140737]]　の例です。

  なお，重複は無しは配慮してありません。（夕焼）

 夕焼けさん、わかりました。

 シート２に予め名前を入れてなかっただけでした。
 振り分けたい名前（重複しない名前）を事前に書き出しておく事はなかったもので、ついそのまま
 実行してしまいました。
 ・・・いつもは実行コード内に入れてましたので。
 申し訳ないです。
 (花粉症は辛い)

 返事が遅くなりました！
 みなさんありがとうございます。
 マクロは使った事がないので、
 夕焼けさんに教えて頂いた過去例の
 SSさんの方法で解決しました。
 また問題が起きた時はヨロシクお願いします。

 (haru)

コメント返信：

[ 一覧(最新更新順) ]

[[20080215144955]] 『重複データのみの抽出』（haru） ページの最後に飛ぶ

[[20080215144955]]　『重複データのみの抽出』（haru）　ページの最後に飛ぶ