エクセル 複数列からの抽出

質問

表題の質問をさせていただきます。

以下の表があります。

りんご　－－－　－－－　－－－
－－－　りんご　－－－　－－－
みかん　－－－　バナナ　－－－
－－－　－－－　－－－　バナナ
バナナ　－－－　みかん　－－－

りんご・みかん等はVLOOKUPで表示されており、「－－－」部も、ここでの質問上 便宜的に「－－－」としていますが　実際にはVLOOKUP関数が入っていてエクセル上では　見た目は空白になっています。

さて、質問なのですが、上記表から文字が入っている部分のみを抜き出して以下のようにしたいのです。
抜き出し先は同一シート内でも別シートでもかまいません。

りんご　りんご　バナナ　バナナ
みかん　　　　　みかん
バナナ

実際の表は30列・80行前後でして、現在は各列毎にオートフィルタの空白以外のセルで選択してコピペを列数分だけ繰り返しています。

関数やVBAで効率よく選択することが出来ますでしょうか。
エクセル２００３です。よろしくお願いいたします。

回答No.1

suekun · ベストアンサー

最初の一番左の列はA列で高さを1～7だと仮定します。

=IF(ISERROR(INDEX(A$1:A$7,SMALL(IF(A$1:A$7="","",ROW(A$1:A$7)),ROW()))),"",INDEX(A$1:A$7,SMALL(IF(A$1:A$7="","",ROW(A$1:A$7)),ROW())))

配列ですので、{}で括って完成
（確定の時に、Ctrlを押しながらShiftを押しながらEnterで確定）

{=IF(ISERROR(INDEX(A$1:A$7,SMALL(IF(A$1:A$7="","",ROW(A$1:A$7)),ROW()))),"",INDEX(A$1:A$7,SMALL(IF(A$1:A$7="","",ROW(A$1:A$7)),ROW())))}

これをそのまま下に右にフィルコピーです。

お礼

早々のお返事ありがとうございます。

自身では思いつけないような、とても複雑な関数でした。
動作も無事に確認できました。
作業効率大幅アップです。
ありがとうございます。

回答No.4

nattocurry

Excel関数を使う方法がいくつか出ているので、あえてマクロを使う方法を。

もともとの表が「Sheet1」という名前のシートにあって、処理結果を「Sheet2」というシートに書き出すとして、
このマクロで大丈夫です。

Sub test()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Dim c As Long
Dim r1 As Long, r2 As Long
For c = 1 To 30
r2 = 1
For r1 = 1 To 80
If Sh1.Cells(r1, c).Value <> "" Then
Sh2.Cells(r2, c).Value = Sh1.Cells(r1, c).Value
r2 = r2 + 1
End If
Next r1
Next c
End Sub

お礼

ご回答いただきありがとうございます。

今までのコピペ作業が　本当にうそのようで、あっちゅうまに作業が終わるようになりました。
ありがとうございます。

動作確認をしている間に　多くのかたに回答をいただいてしまいまし
た。
回答順に点数を付与させていただきましたことを、ご了承ください、

回答No.3

maron--5

A10=IF(ROW(A1)>COUNTA(A$1:A$5),"",INDEX(A$1:A$5,SMALL(INDEX((A$1:A$5="")*100+ROW(A$1:A$5),),ROW(A1))))
★右と下にコピー

お礼

ご回答いただきありがとうございます。

無事に動作確認いたしました。
今まで苦労してコピペしていたのに、夢のようです。

動作確認をしている間に　多くのかたに回答をいただいてしまいまし
た。
回答順に点数を付与させていただきましたことを、ご了承ください、

回答No.2

tom04

こんにちは！
参考になるかどうか分かりませんが・・・

一例として↓の画像のように品物の列分だけ作業列を使う方法になってしまいます。

E1セル=IF(A1="","",ROW())
として　H1セルまでオートフィルでコピー
E1～H1を範囲指定して下へオートフィルでコピー

J1セル　=IF(COUNT(E:E)>=ROW(),INDEX(A:A,SMALL(E:E,ROW())),"")
としてM1セルまでオートフィルでコピー
同じくJ1～M1セルを範囲指定して下へコピーしています。

以上、参考になれば幸いですが、
的外れの回答なら読み流してくださいね。m(__)m

お礼

早々の回答ありがとうございます。

作業列を用いた後の動きが魔法のようなビックリな動作で
感嘆いたしました。
ありがとうございます。

動作確認をしている間に　多くのかたに回答をいただいてしまいまし
た。
回答順に点数を付与させていただきましたことを、ご了承ください、