人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのVBAに関する質問です。データユニークにして抽出したいのですが、簡単な方法はあるでしょうか?
ソートして、順に処理していけばいいのはわかっているのですが、もうちょっと簡単な方法があってもいいように
思えるのですが、フィルタで重複行削除というのもありますが、やや操作が面倒なんで、範囲を選択して、ユニークにするようなのが
あるといいなと思いました。

●質問者: kaiketsu
●カテゴリ:コンピュータ
✍キーワード:VBA エクセル ソート データ フィルタ
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● Mook
●23ポイント

手動で処理をするのであれば、

>フィルタで重複行削除というのもありますが

というのが、一番簡単な処理になると思います。


VBA にしても、上記の手順を実施するのが記述も簡単ですし(マクロの記録でも可)

処理速度的にも早いと思います。


標準機能を使用しないとなると、Dictionary を使用する方法が考えられます。

下記に一応実装例を書いてみました。

Option Explicit

'--------------------------------------------
' 選択されたデータをユニークにしてA列に出力する
'--------------------------------------------
Sub makeUniqueData()
'--------------------------------------------
 Dim objDic As Object
 Dim r As Range
 Set objDic = CreateObject("Scripting.Dictionary")
 For Each r In Selection
 If Not objDic.exists(r.Value) Then
 objDic.Add r.Value, 0
 End If
 Next
 
  ' 結果をA列に出力:A列が選択されていると上書きされます。
 Range("A1").Resize(objDic.Count) = Application.WorksheetFunction.Transpose(objDic.Keys)
 Set objDic = Nothing
End Sub

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.ht...


2 ● GreenStar
●23ポイント

ExcelVBAからならAdvancedFilterで重複無視するのが楽ですね。

下のページで詳しく説明されてますので参照してみてください。

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_advancedfilte...


コメント欄に同じですが、均等割りでポイント配分が減るのは凹みますし、1週間も回答受付中のままだと、まだ情報が足りないのかと思ったりもします。

ポイントは役に立ったかどうかの目安でもありますし、早めに手動で割り振ってもらう事が回答者のモチベーションアップに繋がります。ご理解ご協力をお願いしたいですね。

◎質問者からの返答

ポイントの件はこれから気をつけるようにします。どうもすみません。


3 ● SALINGER
●22ポイント

重複行の削除というのは3通りくらいに落ち着くと思うのだけど

簡単なのはやはりフィルタを使う方法だと思います。


? フィルタを使う方法。

http://office.microsoft.com/ja-jp/excel/HA010346261041.aspx


? 数式を使う方法

作業行に数式を入れて、ソートして削除。

http://blog.texnos.net/?eid=30286

他にcountifを使う方法もありますね。


? マクロ

選択した範囲の重複を削除して上詰めするマクロをちゃんと書くとこんな感じです。

Sub Macro()
 If TypeName(Selection) <> "Range" Then Exit Sub
 Dim r1 As Long
 Dim r2 As Long
 Dim f As Boolean
 Dim ur As Range
 With Selection
 If .Rows.count < 2 Then Exit Sub
 For r1 = .Row + 1 To .Row + .Rows.count - 1
 f = False
 For r2 = .Row To r1 - 1
 If Cells(r1, .Column).Value = Cells(r2, .Column).Value Then
 f = True
 End If
 Next
 If f Then
 If ur Is Nothing Then
 Set ur = Cells(r1, .Column)
 Else
 Set ur = Union(ur, Cells(r1, .Column))
 End If
 End If
 Next
 If Not ur Is Nothing Then
 ur.Delete (xlUp)
 End If
 End With
End Sub

4 ● p332
●22ポイント

自分でも同様の機能が欲しいと思い探したことがあるのですが、やはり標準機能ではフィルタしか無いようなので、VBAで作りました。

選択してから実行すると、別シートに一意で重複数とともに出力します。

ショートカットに登録(Application.Onkey ・・・)しておくと便利です。

参考:

http://officetanaka.net/excel/vba/tips/tips80.htm

Sub GetCount()
 
 Dim Dic As New Dictionary
 Dim RngSrc As Range
 
 Set RngSrc = Selection
 If RngSrc.Cells.Count < 2 Then Exit Function
 
 vals = RngSrc.Value
 
 For Each v In vals
 If Dic.Exists(v) Then
 Dic(v) = Dic(v) + 1
 Else
 Dic.Add v, 1
 End If
 Next
 
 Kys = Dic.Keys
 itms = Dic.Items
 
 With Sheets
 Set RngDst = .Add(after:=.Item(.Count)).Cells(1, 1)
 End With
 
 r = 1
 RngDst(r, 1) = "value"
 RngDst(r, 2) = "count"
 
 For i = 0 To UBound(Kys)
 r = r + 1
 RngDst(r, 1).NumberFormatLocal = "@"
 RngDst(r, 1) = Kys(i)
 RngDst(r, 2) = itms(i)
 Next
 
End Sub

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ