| すぐマク YNxv9864 | Home | Search | Contents | Gallery | Introduction | Service | Support | What's New! |
| 重複データをなくすには？ |
|
|
|||||
|
重複をなくすためのVBAで教えていただきたい事が有ります。 一つは重複をなくすために一方の内容を消去するように設定したいのですが、削除していくために変数の範囲が変わってしまいます。それを変えないようにするにはどうしたら良いかということと、 もう一つは処理したシートにもう一度処理をしてしまうと、内容がすべて消えてしまう結果にならないようにしたいのですが、どうしたら良いでしょうか。 と書いて何が言いたいか伝わらないですね。。。すいません。 マクロは上記のとおりです。
Sub 重複をなくす()
Dim a, b, i
For i = 1 To 20
With Worksheets("sheet1").Cells(i, 2)
b = Worksheets("sheet1").Cells(i, 2)
Set a = .Find(b, lookat:=xlWhole)
If Not a Is Nothing Then
a.Activate
ActiveCell.EntireRow.Select
Selection.Delete
End If
End With
Next i
End Sub
実は上の処理をした後で別のシートと比較し、同じデータを新しいシートにかき出すというVBAを頼まれたのですが、一つづつ切りとって考えているために、上記のような質問になりました。なお、一応 Cell（i,2）のデータのみで、ソートしてもOKです。ソートして 3つ以上ある場合でも、必ず一つを残して消去できるものでしょうか？ |
|
|||
|
Cells(i, 2) のデータ以外のデータ [Cells(i, 1),Cells(i, 3)...] も同様であるなら、
「フィルタオプション」で重複しないデータを生成する事ができますが、Cells(i, 2) だけのため使うことができません。 ソート(並び替え[A to Z])をしてもOKということですから、Findメソッドは使いませんでした。 あくまでサンプルなので、ご期待通りの動作になるかは不明ですが、試してみてください。
--------------------------------------------------------------------------------
Sub test()
Dim ws As Worksheet ' シート
Dim i As Long ' ループカウンタ
Dim rngTarget As Range ' ターゲットRANGE
Dim strChangeValue As String ' 項目変更値
Const lngTargetCol As Long = 1 ' 対象列
' シートセット
Set ws = ActiveSheet
' SORT(並び替え)
Set rngTarget = ws.Cells(1, lngTargetCol)
Call rngTarget.Sort(Key1:=rngTarget, Order1:=xlAscending, Header:=xlGuess)
' 行ごとの処理
Do
i = i + 1
If IsEmpty(ws.Cells(i, lngTargetCol)) Then Exit Do
If i = 1 Then
' 最初の処理
strChangeValue = ws.Cells(i, lngTargetCol)
Else
If strChangeValue = ws.Cells(i, lngTargetCol) Then
' 項目が重複している場合、行の削除
ws.Rows(i & ":" & i).Delete Shift:=xlUp
' 削除した行だけカウントダウン
i = i - 1
Else
' 項目名が変わった場合、項目変更値に格納
strChangeValue = ws.Cells(i, lngTargetCol)
End If
End If
Loop
End Sub
--------------------------------------------------------------------------------
|
| http://www.geocities.jp/happy_ngi/ | Home | Contents | Gallery | Introduction | Service | Support | What's New! |