0

重複する行を取得する次のコードがありますが、重複を太字で強調表示すると同時に削除するコードを取得できません。

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim rng As Range

With ActiveSheet

    iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
    For i = 1 To iLastRow
        If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
    "--(D" & i & ":D" & iLastRow & "=D" & i & ")," & _
    "--(F" & i & ":F" & iLastRow & "=F" & i & ")," & _
    "--(J" & i & ":J" & iLastRow & "=J" & i & ")," & _
        "--(K" & i & ":K" & iLastRow & "=K" & i & "))") > 1 Then
            If rng Is Nothing Then
                Set rng = .Cells(i, "A").Resize(, 11)
            Else
                Set rng = Union(rng, .Cells(i, "A").Resize(, 11))
            End If
        End If
    Next i

    **If Not rng Is Nothing Then rng.Delete.font.bold = true**


End With

サブ終了

データセットと目的の出力の例は、以下のダウンロード可能なリンクで確認できます。

https://www.dropbox.com/s/7rhktg6b4nk6ig0/Bold_highlight_Duplicate%20.xlsm

どんな助けでも大歓迎です。ありがとうございました。

編集：

明確にするために、これはどのように見えるかです。入力が削除され、太字の強調表示が出力セクションに表示されます。

ここに画像の説明を入力してください

4

1 に答える 1

0

以下を使用する代わりに**If Not rng Is Nothing Then rng.Delete.font.bold = true**：

If Not rng Is Nothing Then
  with rng
   .Offset(.Areas(.Areas.Count).Rows(.Areas(.Areas.Count).Rows.Count).Row + 1).Font.Bold = True
   .Delete
  end with
End If

これはどのように機能しますか？

重複をテストするときに太字のインジケーターを設定することもできますが、それを許可しない別のアプローチを採用しました。

つまり、あなたrngはマルチエリアの選択です。

最後の領域に移動し、次にその領域の最後の行に移動してから、実際の行を取得する必要があります。次に、その間のスペースに+1を追加します。これで、入力セクションでカバーされる行数+出力へのギャップがわかり、このカウントによって選択を出力セクションにオフセットします。

ただし、複雑な問題が発生する可能性があります。入力/出力に依存します。これは、例で簡単にテストしましたが、機能しました。それでも、別の種類のループと重複検出を使用する方がよいと思います。

于 2012-10-25T11:54:17.000 に答える