| |
▼カド さん：
こんばんは。
>選択しているｎ列において重複しているデーターが有った場合は、
>そのデーターがある最後の行を残して、その他の行は削除してしまいたいのです。
>
>一般的な？コードは、最初にソートするため順番が変わってしまいますが、
>順番は変えずに出来ないでしょうか？
>
>また行を削除するとは、データを消して空白行を残すのではなく、
>行そのものを削除するものとします。
>
>一から書いてもらうのは大変申し訳ないので、既に作成ずみのコードがあれば
>教えていただくか、フリーソフトなどでご存知のものがあれば紹介ください。
以下のコードは、
例えば、下のようなデータがＡ列、Ｂ列の１行目からあったとします。
Ａ Ｂ
1 a
2 b
3 c
4 d
5 a
6 b
7 c
8 d
9 a
10 b
11 c
12 d
この時、セルＢ１〜Ｂ12を選択して、後述するマクロを実行して下さい。
結果は、
Ａ Ｂ
9 a
10 b
11 c
12 d
となります。大体こういう仕様ですよね？
尚、作業エリアとして、アクティブシートの次のシート（右隣のシート）
を使用しますので、用意して置いて下さい。
標準モジュールに
'================================================================
Sub main()
Dim rng As Range
Dim ans As Range
Set rng = Selection
If rng.Count <= 1 Then
Exit Sub
End If
Set ans = get_dup_last_rng(rng, ActiveSheet.Next, False)
If Not ans Is Nothing Then
ans.EntireRow.Delete
End If
End Sub
'================================================================
Function get_dup_last_rng(rng As Range, sht As Worksheet, v_or_b As Boolean)
'rng : 重複チェックセル範囲
'sht : 作業シート
'v_or_b: true 重複処理後、データと認識されるセル範囲の取得
' false 重複処理後、データと認識しないセル範囲を取得
Dim motosht As Worksheet
Dim wk As Range
Set motosht = rng.Parent
sht.Cells.ClearContents
addr1 = rng.Cells(1).Address(False, False, , True)
addr2 = rng.Cells(1).Address(, , , True) & ":" & addr1
addr3 = rng.Address(, , , True)
With sht.Range(rng.Address)
.Formula = "=IF(COUNTIF(" & addr2 & "," & addr1 & _
")=COUNTIF(" & _
addr3 & "," & addr1 & ")," & _
addr1 & ","""")"
.Value = .Value
On Error Resume Next
If v_or_b = True Then
Set wk = .SpecialCells(xlCellTypeConstants)
Else
Set wk = .SpecialCells(xlCellTypeBlanks)
End If
If Err.Number <> 0 Then
Set get_dup_last_rng = Nothing
Else
Set get_dup_last_rng = motosht.Range(wk.Address)
End If
.Parent.Cells.ClearContents
End With
End Function
確認してみて下さい。
|
|
- 04/3/17(水) 18:48 -
