[[20180110135332]]　『複数列からのユニークな値の抽出』（まる）　ページの最後に飛ぶ

『複数列からのユニークな値の抽出』（まる）

いつも参考にさせて頂いております。
質問をさせて頂きます。

1 2 3 4
A1
A1 A2 B1
B2 A2 C1
C2 B2
B1 C1 A1 A2

上記のようにアルファベットと記号の組み合わせによるコードのデータがあります。行ごとにコードが入力されている数は異なり、上記のように空白がある状態です。また、コードは左から昇順に並んでおりません。
このような表からユニークな値を1列に出力する方法をご教示頂きたく存じます。最終的に、A1 A2 B1 B2 C1 C2の6つのユニークな値を取り出すのが目的です。
実際のデータ量は47列×2800行あります。

お手数をお掛け致しますが、よろしくお願いいたします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

確認ですが、VBAの使用を前提にしてますか？
それともワークシート関数だけをつかってなんとかしたいですか？
（もこな２） 2018/01/10(水) 14:14

もこな２様

ご返信ありがとうございます。
Excelに関しては初心者ですので、VBAは使用できません。
可能であれば関数で何とかしたいと考えております。
（まる） 2018/01/10(水) 14:15

かなり難しい内容なので、マクロを使わないと大変だと思いますよ？
とりあえずマクロ案。 Sheet1 に元データがあり、対象以外の情報は無しとします。出力は Sheet2 に行うものとします。

 Sub test()
    Dim R As Range

    With CreateObject("System.Collections.ArrayList")
        For Each R In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
            If .Contains(R.Text) = False Then
                .Add R.Text
            End If
        Next R

        .Sort
        Sheets("Sheet2").Range("A1").Resize(1, .Count).Value = .toarray
    End With
 End Sub
（???） 2018/01/10(水) 14:28

???様

ご返信ありがとうございます。
VBAは使用したことがありませんでしたが、ご教示頂いたコードをVBEに貼り付けて実行したところ
「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです。」と表示されました。
デバックをクリックすると「Sheets("Sheet2").Range("A1").Resize(1, .Count).Value = .toarray」の行が黄色くハイライトされております。
Sheet1にはA1からAU2829までデータのみ入力されており、Sheet2は空の状態です。

大変お手数をお掛け致しますが、解決策をご教示願えませんでしょうか。
（まる） 2018/01/10(水) 15:17

 一応関数で出来たが(シートを1枚、作業用に使う)計算に少々時間がかかる。
 元のデータがSheet1、作業用がSheet2、結果をSheet3に求めるとする。
 Sheet2のA1セルに
 =IF(COUNTIF(Sheet1!$A$1:A1,Sheet1!A1)=1,ROW(A1)*100+COLUMN(A1),"")
 と入力し、AU1セルまでフィルコピー。
（ねむねむ） 2018/01/10(水) 15:39

 Sheet2のA2セルに
 =IF(COUNTIF(Sheet1!$A$1:$AU1,Sheet1!A2)+COUNTIF(Sheet1!$A2:A2,Sheet1!A2)=1,ROW(A2)*100+COLUMN(A2),"")
 と入力してAU2800セルまで右および下へフィルコピー。
（ねむねむ） 2018/01/10(水) 15:40

 その後、Sheet3のA1セルに
 =IFERROR(INDEX(Sheet1!$A$1:$AU$2800,INT(SMALL(Sheet2!$A$1:$AU$2800,ROW(A1))/100),MOD(SMALL(Sheet2!$A$1:$AU$2800,ROW(A1)),100)),"")
 と入力して下へフィルコピーしてみてくれ、
（ねむねむ） 2018/01/10(水) 15:40

ねむねむ様

ご返信ありがとうございます。
ご提示いただいた関数で計算を試みておりますが、計算に非常に時間がかかっており
Sheet3での計算は1セルあたり10分以上かかりそうな様相です…(まだ計算が完了しておりません。)
（まる） 2018/01/10(水) 15:59

 まるさん、一応こちらでは数分単位で終っていたがもしかすると元の表のほとんどが空白状態のためかもしれない。
 すまない。
（ねむねむ） 2018/01/10(水) 16:16

Excelの扱える列数は16384列までなので、重複を除いたデータ数がこれより多いと、おっしゃっているようなエラーになります。
出力している箇所を以下のように変えて、縦1列にすれば動作するかと思いますが、いかがでしょうか？

    Sheets("Sheet2").Range("A1").Resize(.Count, 1).Value = WorksheetFunction.Transpose(.toarray)
（???） 2018/01/10(水) 16:21

ねむねむ様

確かに元の表には空白が多数存在しております。
データが入力されている列が最長AU列までであり、それに満たない行が多数です。
こちらこそお手数をお掛けして申し訳ありません。

???様

ご提示いただいた変更を行ったところ、問題なく動作致しました。
確かに重複を除いたデータ数は17000を超えておりました。
本当に助かりました。誠にありがとうございます。
（まる） 2018/01/10(水) 16:26

いろいろ考えてるうちに解決したようで何より。
とりあえず、こんなアプローチもあるってことで投稿しておきます。（効率がよいとは言えない・・・）

◆使う関数
＜INDEX関数＞

◆作業工程
作業シートを用意して、
A1に「1」と入力。A28に「2」と入力。
A1からA54までを選択して、54,000行目をすぎるあたりまでフィル。
（この作業で、A列は27行おきに１，２．３ってなってるはず）
日本語入力になっていたら解除。
A1からA54000くらいを範囲選択。
（D列でもクリックしてctrl＋下矢印で最終行に飛んでから、A列の最終行にカーソル移動して、ctrl＋上矢印、
カーソルは動かさずに、マウスでスクロールバー上にあげてシフトキー押しながらA1をクリック）
ctrl＋G　を押して　「ジャンプ」って出てきたら「セル選択」をクリック
空白セルを選択
そうすると、A列の空白セルが選択されつつ、最初の空白セルがアクティブになっているので。「＝」を入力して上矢印を１回押してctrl＋エンター
(これで、A列は1が27こ、2が27こって並んでる状態になる)
次に、B1に「1」,B2に「2」．．．B27に「27」と入力。（オートフィル使ってください）
B1からB27を選択してctrl押しながら54,000行目をすぎるあたりまでフィル。
（この作業で、B列は１から27までの繰り返しがずらっと並んでるはず）

この作業が終わればまぁ後は楽です。
C1に「=INDEX(Sheet1!A:AA,A1,B1)」と数式を設定して
C2からC54000まで、フィルでもコピペでもいいのでC1の数式を設定

これで、sheet1の表？に入ってるデータを１列に直すことが出来ます。

１列になっちゃえば、適当なところに、コピー＆値貼付して、
「データ」－「重複の削除」選べばミッション完了ですよね。
（もこな２） 2018/01/10(水) 16:32

もこな様

ご返信ありがとうございます。
他の場面でも複数列を1列にまとるのに四苦八苦するので、この方法も応用できる場面があると思います。
本当にありがとうございました。
（まる） 2018/01/10(水) 17:31

コメント返信：

[ 一覧(最新更新順) ]

[[20180110135332]] 『複数列からのユニークな値の抽出』（まる） ページの最後に飛ぶ

[[20180110135332]]　『複数列からのユニークな値の抽出』（まる）　ページの最後に飛ぶ