• 締切済み

一つのセルにまとめる

A列が同じ値の範囲の、B列の重複していない文字をC列に書き出すか、一つのセルにまとめたいです。 もう頭が回らない為、知恵を貸して頂けるとありがたいです。 第一希望 A列 B列 C列 くま組 gさん gさんjさんmさん くま組 jさん くま組 mさん りす組 aさん aさんgさん りす組 gさん さる組 pさん pさんjさんcさん さる組 jさん さる組 pさん さる組 cさん 第二希望 A列 B列 C列 くま組 gさん gさん くま組 jさん jさん くま組 mさん mさん りす組 aさん aさん りす組 gさん gさん さる組 pさん pさん さる組 jさん jさん さる組 pさん cさん さる組 cさん

みんなの回答

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.4

質問にあるように組が並んでいる状態で関数を作ってみました。A列は「組」、B列は「名前」、C、D、F列は作業用列。E列は「第一希望」、G列が「第二希望」です。Sheet1で計算しています。 C2: =A2&"_"&B2 D2: =IF(A2<>A1,B2,IF(COUNTIF(C$2:C2,C2)=1,D1&","&B2,D1)) E2: =IF(A2<>A1,INDEX(D2:D$10000,COUNTIF(A:A,A2),1),"") F2: =IFERROR(IF(A2<>A1,E2,MID(F1,FIND(",",F1)+1,LEN(F1))),"") G2: =LEFT(F2,FIND(",",F2&",")-1) 入力が終わったら、セル範囲C2:G2を下にコピーします。式を簡素化するために、データは1万件未満としています。 セルE2の「10000」がそれに当たります。必要なら増やしてください。C、D、F列は作業用列なので非表示にしてもかまいません。関数の場合、組の最初に書いたり、詰めて書くのが面倒なので補助列を使っています。シートの状態は添付図を参照してください。 VBAは簡単にできるので合わせて書いておきます。 Sheet2にSheet1のA、B列の値を貼り付けてください。表題と「くま組」~「さる組」の10行2列です。VBAは何行あっても動きます。AB列に質問のようなデータが入力されていればいいです。 ●「開発」タブをクリックして「Visual Basic」ボタンをクリックします。(または ALTキー+F11キー を押します) ●Microsoft Visual Basic for Applications の画面が開きます。(VBE) ●VBE画面の左にプロジェクト画面が表示されていなかったら、メニューから、表示>プロジェクトエクスプローラーを選択します。 ●プロジェクトエクスプローラーが表示されたら、ツリー表示の「Sheet2」をダブルクリックします。 ●表示された広い画面に回答したコート(「Sub まとめ() ~ End Sub」になります)をコピーして貼り付けます。 ●ExcelのSheet2に戻って、「開発」タブ>「マクロ」ボタンをクリックして、「Sheet2.まとめ」を選択して「実行」ボタンをクリックします。  ※「開発」タブの表示はされているものとしています。 Sub まとめ()   Dim rw As Long       '// 行カウンタ   Dim rwWrite1 As Long   '// 第一希望書き出し行   Dim rwWrite2 As Long   '// 第二希望書き出し行   Dim Kumi As String     '// 組   Dim Ketsugou As String  '// 第一希望の結合結果      Range("C:D").ClearContents  '// 結果出力列をクリア   Range("C1:D1") = Array("第一希望", "第二希望")      With Range("B2")     While .Offset(rw, 0) <> ""       '// 組の最初の行で初期化       rwWrite1 = rw: rwWrite2 = rw: Kumi = .Offset(rw, -1)       Ketsugou = .Offset(rw, 0)       .Offset(rwWrite2, 2) = .Offset(rw, 0) '// 第二希望              rw = rw + 1       '// 同一組の場合       While .Offset(rw, -1) = Kumi         If InStr(Ketsugou, .Offset(rw, 0)) = False Then           '// 重複してなければ結合する           Ketsugou = Ketsugou & .Offset(rw, 0)           '// 第二希望           rwWrite2 = rwWrite2 + 1           .Offset(rwWrite2, 2) = .Offset(rw, 0)         End If                  rw = rw + 1       Wend              .Offset(rwWrite1, 1) = Ketsugou '// 第一希望     Wend   End With End Sub 関数を使うほうが興味深いですね。

回答No.3

重複しない、ユニークな○○さんを抽出したい、ということなんでしょうか? それであれば、逆に、重複をピックアップして、フィルタで非表示にするというのはどうでしょう。 C列に =IF(COUNTIF($B$2:B2,B2)>1,"重複","") と入れ、全行にコピーしてください。 名前が重複している、二個目から「重複」と表示されます。 フィルタで、C列を空白セルにのみチェックすれば、重複しないデータだけになります。

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.2

こんにちは! >一つのセルにまとめたいです。 というコトですので、VBAになってしまいますが一例です。 ↓の画像のように元データが左側(Sheet1)のようになっていて、 右側のSheet2に表示させるとします。 Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに ↓のコードをコピー&ペースト → Excel画面に戻りマクロを実行してみてください。 (Alt+F8キー → マクロ → マクロ実行です) Sub Sample1() 'この行から Dim i As Long, str As String, c As Range, wS As Worksheet Set wS = Worksheets("Sheet2") wS.Cells.Clear With Worksheets("Sheet1") .Range("A:A").AdvancedFilter Action:=xlFilterInPlace, unique:=True .Range("A:A").Copy wS.Range("A1") .ShowAllData For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole) If wS.Cells(c.Row, "B") = "" Then wS.Cells(c.Row, "B") = .Cells(i, "B") Else If InStr(wS.Cells(c.Row, "B"), .Cells(i, "B")) = 0 Then wS.Cells(c.Row, "B") = wS.Cells(c.Row, "B") & "," & .Cells(i, "B") End If End If Next i wS.Columns.AutoFit End With End Sub 'この行まで こんな感じではどうでしょうか?m(_ _)m

atgm1200
質問者

お礼

まさにこれです。こういう結果を出したかったんです。 書き出し場所を少し修正して活用させて頂きたいと思います。 やっぱりマクロ勉強しなきゃダメですね。 わかりにくい質問を読み取っていただきありがとうございました。

  • RandenSai
  • ベストアンサー率54% (305/561)
回答No.1

今の指定条件と、例示の第1希望・第2希望が全くつながらないんですが… 疑問点: A列 くま組 B列 gさん C列 gさんjさんmさん ←jさんmさんはどこから湧いて出てきた? とにかく、セルの文字列の検索や抽出は、次の解説が答えです。この解説の下の方にある、関連する記事というリンクにも大きなヒントがあります。 http://www.relief.jp/itnote/archives/000103.php

atgm1200
質問者

補足

質問内容が少し難しかったようで、すみませんでした。 2番の方の回答を見ていただければ理解頂けると思います。

関連するQ&A

専門家に質問してみよう