Excel2010で行ごとの重複削除

質問

Excel2010です。

A行目　1 3 5 5 2 2 3
B行目　2 3 5 5 4 4
C行目　1 9 7 9 9

↓

A行目　1 3 5 2
B行目 2 3 4 5
C行目　1 7 9

というように、行ごとに重複の削除をしたいと思っています。

データタブに重複の削除があるのですが、列ごとにやるようなので、一度シート全体を
行と列を入れ替えて別シートにコピーして、
１列目全体を選択して、１列目で重複の削除を実行
２列目全体を選択して、２列目で重複の削除を実行
・・・
というやり方もあるのですが、今扱っているエクセルは１９７行１９７列あります。
列選択、重複の削除アイコンをクリックするのを１９７回繰り返すのは大変です。

自動化する方法はないものでしょうか？

回答No.1

tom04 · ベストアンサー

こんばんは！
A行目となっているのは1行目のことですよね？
↓の画像のような配置になっていて、行単位で判断して重複するものだけを削除！
という解釈での方法です。

VBAになってしまいますが・・・
一例です。

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

Sub test() 'この行から
Dim i, j As Long
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row '1行目からA列の最終行まで
For j = Cells(i, Columns.Count).End(xlToLeft).Column To 1 Step -1 'i列の最終列からA列まで
If WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, j)), Cells(i, j)) <> 1 Then
Cells(i, j).Delete (xlToLeft)
End If
Next j
Next i
End Sub 'この行まで

こんな感じで良かったのですかね？m(__)m

お礼

まさにそれです。ありがとうございます。これで作業が進みそうです。

回答No.3

keithin

>列選択、重複の削除アイコンをクリックするのを１９７回繰り返すのは大変です。

という事で，それをマクロで自動化してみます。

ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

Sub Macro1()
　Dim wo As Worksheet
　Dim wt As Worksheet
　Dim wr As Worksheet
　Dim c As Long

　Set wo = ActiveSheet
　Set wt = Worksheets.Add
　wo.Range("A1").CurrentRegion.Copy
　wt.Range("A1").PasteSpecial Transpose:=True
　For c = 1 To wt.Range("A1").CurrentRegion.Columns.Count
　wt.Range("A1").CurrentRegion.Columns(c).RemoveDuplicates Columns:=1, Header:=xlNo
　Next c

　Set wr = Worksheets.Add
　wt.Range("A1").CurrentRegion.Copy
　wr.Range("A1").PasteSpecial Transpose:=True
End Sub

ファイルメニューから終了してエクセルに戻り，
元データのシートを開き
エクセルのオプションから開発タブを表示しておいて,マクロのボタンから今登録したMacro1を実行する。

＃こんな方法もあります。
シート１のA1から元データがあるとして。
シート２のA1に
=IF(COUNTIF(Sheet1!$A1:A1,Sheet1!A1)=1,Sheet1!A1,NA())
と記入，シート１のデータのある範囲に満遍なくコピー貼り付ける
Ctrl+Gを押し，現れたダイアログでセル選択をクリック，現れたダイアログで数式にマークしてエラー値のみチェックを残してその他のチェックを外し，OKする
#N/Aのセルが飛び飛びで選択されるので，飛び飛びの選択状態を崩さないよう上手く１個の#N/Aのセルを右クリックして削除を選び，左に詰めてOKする。

お礼

いろんな裏ワザがあるのですね。ありがとうございます。

回答No.2

noname#204879

あいにく Excel 2010 を持っていないので、Excel 2002 での方法になります。

添付図参照

Sheet1: オリジナル・データ
Sheet2!B1: =IF(ISERROR(SMALL(Sheet1!$A1:$G1,COLUMN(A1))),"",SMALL(Sheet1!$A1:$G1,COLUMN(A1)))
　　　　(Ａ列は空白のまま)
Sheet3!A1: =IF(Sheet2!B1=Sheet2!A1,"",Sheet2!B1)
Sheet4!A1: =IF(ISERROR(SMALL(Sheet3!1:1,COLUMN(A1))),"",SMALL(Sheet3!1:1,COLUMN(A1)))

お礼

ＳＭＡＬＬは見たことがなかったです。調べてみます。