人に聞けない痔の悩み、これでスッキリ >>

A~D列に言葉が入っているのを、F列以降に空白、重複を除いて、結果を表示したいのですが、やり方がわかりません。(別シートではなく、同じシート内で処理したいです。)
A~D列に入る言葉は200個程の種類があります。
行は4万行くらいのデーターがあるので行列を入れ替えた表には出来ません。
ジャンプで空白セル選択→まとめて削除をすると、データー数が多いので、パソコンが固まってしまいました。
なので、行ごとに処理をしたいのです。
よろしくお願いします。


 A     B   C    D        F     G    H    I
みかん ぶどう りんご みかん → みかん りんご ぶどう
みかん (空白) (空白) みかん → みかん
(空白) ぶどう りんご みかん → ぶどう  りんご みかん
みかん ぶどう りんご すいか → みかん ぶどう りんご すいか

A 回答 (3件)

F1に


=INDEX($A1:$E1,SMALL(IF(($A1:$D1<>"")*(MATCH($A1:$D1&"",$A1:$D1&"",0)=COLUMN($A1:$D1)),COLUMN($A1:$D1),5),COLUMN(A1)))&""
と式を記入してコントロールキーとシフトキーを押しながらEnterで入力,
コピーしてG1:I1に貼り付け
さらにF1:I1をコピーして下に貼り付けます。

4万行程度なら,瞬殺とはさすがに言いませんがさほど負荷無く計算できます。



#式中でE1が出てくるのは間違いではないので気をつけてください。
 逆にE列は計算で使っているので,必ず「何も記入しない」でおいてください
    • good
    • 0
この回答へのお礼

お礼が遅くなりすみません。

参考になりました。
実際の表は、AB列から始まっていたので、そのままでは使えない為、解読するのに時間が掛かり、一苦労しましたが、私が描いていた通りの結果の上、処理が軽いお陰で、件数が多くても問題ありませんでした。

ありがとうございました。

お礼日時:2011/12/20 18:47

一例です。


この要件ならばマクロ(VBA)の方が良いと思います(私用PCでは12秒程度)
(1)対象データシート名上で右クリック→コードの表示(VBE画面表示)→以下のコード
   貼り付け→F5キー押下でお試しください。
   尚、マクロの削除は、貼り付けコードを削除でOKです。

Sub sample()
Application.ScreenUpdating = False
Set Db = CreateObject("Scripting.Dictionary")
For i = 1 To Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
For j = 1 To 4
If Cells(i, j) <> "" Then
Db(Cells(i, j).Value) = 1
End If
Next
wk = Db.keys
For n = 0 To Db.Count - 1
Cells(i, 6 + n) = wk(n)
Next
Db.RemoveAll
Next
Application.ScreenUpdating = True
End Sub
    • good
    • 0
この回答へのお礼

お礼が遅くなりすみません。

参考になりましたが、件数が多いので、処理に時間が掛かってしまい、今回はこの方法は断念しました。
別の機会にでも参考にさせていただきたいと思います。

ありがとうございました。

お礼日時:2011/12/20 18:44

こんばんは!


VBAになってしまいますが・・・
一例です。
データは1行目からあるとします。

画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面が出ますので
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub test() 'この行から
Dim i, j As Long
Application.ScreenUpdating = False
For i = 1 To UsedRange.Rows.Count
Range(Cells(i, 1), Cells(i, 4)).Copy Destination:=Cells(i, 6)
For j = 9 To 6 Step -1
If Cells(i, j) = "" Then
Cells(i, j).Delete (xlToLeft)
ElseIf WorksheetFunction.CountIf(Range(Cells(i, 6), Cells(i, j)), Cells(i, j)) > 1 Then
Cells(i, j).Delete (xlToLeft)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

※ ご希望の方法でなかったらごめんなさいね。m(__)m
    • good
    • 0
この回答へのお礼

お礼が遅くなりすみません。

参考になりましたが、件数が多いので、処理に時間が掛かってしまい、今回はこの方法は断念しました。
別の機会にでも参考にさせていただきたいと思います。

ありがとうございました。

お礼日時:2011/12/20 18:44

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


このカテゴリの人気Q&Aランキング