Excel - 行内の重複する列の値を強調表示して削除する

Question

私は数百列のデータを持つ大きなドキュメントを扱っています。これらの行の多くには、削除する必要がある列の重複値があります。

サンプルシートは次のとおりです。

必要なのは、各行を調べて、列 B:E の重複を見つけ、1 つのセルを除いてすべて削除し、できれば残りのセルを左にシフトして空白セルを回避することです。すべての行と残りのデータをそのまま保持する必要があります。

したがって、上記の例では、結果は次のようになります。

いくつかの注意点:

• 問題のセルはすべて各行の末尾に表示されます
• 理由: これらすべての値は 1 つの列にリストとして保存され、 を使用して分割されましたText to Columns。ここで、これをクリーンアップして重複を削除する必要があります。
• 重複している可能性のある行が数千行、列が数百あります。

これは VBA でも可能ですか? ご提案があればぜひお願いします。 ありがとうございます!

Answer 1

投稿された回答の速度テストの結果は次のとおりです (10K 行、1K 列)。

VBA 1 - Time:  19.488 sec - RemoveRowDupes (this answer)

VBA 2 - Time: 109.434 sec - dostuff (after turning off ScreenUpdating)

Formula test: N/A (gave up after 5 minutes filling out 10Kx1K range with array, at 9%)

---

Option Explicit
Public Sub RemoveRowDupes()
    Dim ur As Range, cc As Long, r As Range, a As Variant
    Dim s As String, i As Long, l As Long, t As Long, tt As Double, tr As String
    tt = Timer
    Set ur = Sheet1.UsedRange
    cc = ur.Columns.Count - 1
    With ur.Offset(, 1).Resize(, cc)
        Application.ScreenUpdating = False
        For Each r In .Rows
            s = Join(Application.Transpose(Application.Transpose(r)), "|")
            a = Split(s, "|"):
            l = Len(s)
            For i = 0 To cc - 1
                If Len(a(i)) > 0 Then
                    s = Replace(s, a(i), "^^")
                    s = Replace(s, "^^", a(i), , 1)
                    s = Replace(s, "^^", vbNullString)
                    If l > Len(s) Then
                        a = Split(s, "|")
                        l = Len(s)
                    End If
                End If
            Next
            s = Replace(s, "||", "|")
            If Right(s, 1) = "|" Then s = Left(s, Len(s) - 1)
            t = Len(s) - Len(Replace(s, "|", ""))
            r.ClearContents:    r.Resize(, t + 1) = Split(s, "|")
        Next
        Application.ScreenUpdating = True
    End With
    tr = "Rows: " & Format(ur.Rows.Count,"#,###") & "; Cols: " & Format(cc,"#,###") & "; "
    Debug.Print tr & "Time: " & Format(Timer - tt, "0.000") & " sec - RemoveRowDupes()"
End Sub

---

テストデータ：

---

結果 - RemoveRowDupes()

---

結果 - dostuff()

---

注記：この回答は、範囲を操作する代わりに配列を使用することで（必要な場合）改善できます。

Answer 2

VB を使用してデータをその場で処理する場合は、次のようにします。

Sub dostuff()
Dim myarray As Variant
ReDim myarray(10000)

i = 0 'row iterator

Do While (Range("A1").Offset(i, 0).Value <> "")
 j = 0 'single item iterator
 k = 0 'column iterator
 m = 0 'stored array iterator
 m_max = 0 'number of unique values on the row

 'iterate single values
 Do While (Range("B1").Offset(i, j).Value <> "")
  temp = Range("B1").Offset(i, j).Value

  'compare to saved
  flag = 0
  m = 0
  Do While (m <= m_max)
   If temp = myarray(m) Then
     flag = 1
   End If
   m = m + 1
  Loop

  'add if unique
  If flag = 0 Then
   m_max = m_max + 1
   myarray(m_max) = temp
  End If

  j = j + 1
 Loop

 'clear existing
 Range("B1").Offset(i, 0).Select
 Range(Selection, Selection.End(xlToRight)).Clear

 'write saved
 m = 1
 Do While m <= m_max
  Range("B1").Offset(i, m - 1).Value = myarray(m)
  m = m + 1
 Loop

  i = i + 1
Loop
End Sub

Answer 3

数式を使用してこれを行うこともできますが、正しい値は少なくとも一時的には別の場所にあります。データを同じ場所に保持するには、新しいデータをコピーし、[形式を選択して貼り付け] > [値] を選択して古いデータを上書きします。

この配列数式は、B7 から右下方向に入力され、次のような結果を生成します。

=IFERROR(INDEX($B1:$E1,,MATCH(0,COUNTIF($A7:A7,$B1:$E1),0)),"")

これは配列数式なので、 とともに入力する必要があることに注意してくださいCTRLShiftEnter。

この式がどのように機能するかについてのチュートリアルは以下にあります。エクセルジェット。