Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


69382 / 76732 ←次へ | 前へ→

【11868】Re:重複セルの削除
回答  ichinose  - 04/3/17(水) 21:10 -

引用なし
パスワード
   ▼カド さん:
こんばんは。
>選択しているn列において重複しているデーターが有った場合は、
>そのデーターがある最後の行を残して、その他の行は削除してしまいたいのです。
>
>一般的な?コードは、最初にソートするため順番が変わってしまいますが、
>順番は変えずに出来ないでしょうか?
>
>また行を削除するとは、データを消して空白行を残すのではなく、
>行そのものを削除するものとします。
>
>一から書いてもらうのは大変申し訳ないので、既に作成ずみのコードがあれば
>教えていただくか、フリーソフトなどでご存知のものがあれば紹介ください。


以下のコードは、
 例えば、下のようなデータがA列、B列の1行目からあったとします。

A    B
1    a
2    b
3    c
4    d
5    a
6    b
7    c
8    d
9    a
10    b
11    c
12    d

この時、セルB1〜B12を選択して、後述するマクロを実行して下さい。

結果は、
A    B
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

確認してみて下さい。

2 hits

【11865】重複セルの削除 カド 04/3/17(水) 18:48 質問
【11866】Re:重複セルの削除 Asaki 04/3/17(水) 20:08 回答
【11868】Re:重複セルの削除 ichinose 04/3/17(水) 21:10 回答
【11869】Re:重複セルの削除 カド 04/3/17(水) 21:53 お礼
【11870】Re:重複セルの削除 Hirofumi 04/3/17(水) 21:56 回答
【11871】Re:重複セルの削除 カド 04/3/17(水) 23:09 お礼

69382 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free