vbaを使用してExcelの重複行を削除します

Question

私は文字列値を持つデータの列を持っています。私はその列の各セルで比較を行い、その値が重複しているかどうかをチェックしたい。比較は、フルテキストとワイルドカードの両方である必要があります。 |

以下

あなたはスクリーンショットを見れば、会社CESリミテッドは別の会社ECLERX SERVICES LTDとともに行17上だけでなく、3行目に存在する私のデータのスクリーンショット

ですCES Limited。ですから、このような重複値を強調したいと思います。以下は

コードは、すべての細胞が異なるように強調してしかし、私は

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer 
 

 
Set rangeToUse = Selection 
 

 
Cells.Interior.ColorIndex = 0 
 
Cells.Borders.LineStyle = xlNone 
 

 
For Each singleArea In rangeToUse.Areas 
 
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin 
 
Next singleArea 
 

 
For i = 1 To rangeToUse.Areas.Count 
 
    For Each cell1 In rangeToUse.Areas(i) 
 
    MsgBox cell1.Value 
 
     For j = 1 To rangeToUse.Areas.Count 
 
       For Each cell2 In rangeToUse.Areas(j) 
 
        If cell1.Value = cell2.Value Then 
 
         cell2.Interior.ColorIndex = 38 
 
        End If 
 
        MsgBox cell2.Value 
 
       Next cell2 
 
     Next j 
 
    Next cell1 
 
Next i

を書いたコードです。誰でも私が間違っていることを教えてもらえますか？

Answer 1

あなたのコードは、常に重複を見つける：これはあなたのために働くならば、それは一つのセルの文字列全体の横に列に1を配置することによって、他の一部を構成するフラグます顔をしていますあなたの比較の1つが常にそれ自身の細胞であるからです。

ここでは、コレクションオブジェクトを使用して重複を検出する方法を示します。既存のアイテムと同じキーを持つアイテムを追加しようとすると、コレクションはエラーを返します。私たちはそれをテストします。

セル内に2つ（またはそれ以上）がある場合は、会社名を分割する必要もあります。あなたのサンプルでは、​​それらは|（パイプはスペースで囲まれています）で分割されているようですが、スクリーンショットが理想的でない場合があることを確認してください。

が、これはあなたが開始されるかどうかを確認してください：

---

Option Explicit 
Sub ColorDups() 
Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer 
Set rangeToUse = [a1:a23] 'hard coded for testing 

Cells.Interior.ColorIndex = 0 
Cells.Borders.LineStyle = xlNone 

For Each singleArea In rangeToUse.Areas 
    singleArea.ClearFormats 
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin 
Next singleArea 

'Generate Unique companies list and flag duplicates 
Dim colCompanies As Collection 
Dim vCompany As Variant 
Dim S(0 To 1) As String 
Set colCompanies = New Collection 
On Error Resume Next 
For i = 1 To rangeToUse.Areas.Count 
    For Each cell1 In rangeToUse.Areas(i) 
     vCompany = Split(cell1.Text, " | ") 
     For j = LBound(vCompany) To UBound(vCompany) 
      S(0) = Trim(vCompany(j)) 
      S(1) = cell1.Address 
      colCompanies.Add S, S(0) 
      Select Case Err.Number 
       Case 457 'we have a duplicate 
        Err.Clear 
        cell1.Interior.ColorIndex = 38 
        Range(colCompanies(S(0))(1)).Interior.ColorIndex = 38 
       Case Is <> 0 'debugstop 
        Debug.Print Err.Number, Err.Description 
        Stop 
      End Select 
     Next j 
    Next cell1 
Next i 
On Error GoTo 0 

End Sub 

---

これはあなたのデータと上記のマクロを使用した結果です。いくつかの異なる色を使用して、および/または一致するセル範囲を出力することによって強化することができます。など

Answer 2

これはあなたの選択あなたの出現回数を与える

WorksheetFunction.CountIf（rangeToUse、 "" &セル2 & ""）

あなたがを反復処理していることをそれに表示されます非連続的な選択。あなたは

WorksheetFunction.CountIf（rangeToUse.Areas（j）は、 "" &セル2 & ""）

Answer 3

を使用するセル2の領域に出現回数をカウントしたい場合はそれは私には思われます正確なセルの値に一致するようにコーディングしていますが、あなたの例では、CES LimitedとECLERX SERVICES LTD | CESリミテッドは一致を返すべきです。

これを異なる色としてどのように表示しているのか、ECLERXが別のもので再び表示される場合、どのような色になるのかを検討する必要があります。

あなたは本当にちょうど次のコードごとに重複を返す場合は、これを達成することができる可能性がありますあなたは、おそらく分離する必要がありますし、

Sub Whatever() 

Dim Loc As Range 
Dim Loc2 As Range 
Dim cell As Range 
Dim myrange As Range 

Set myrange = -Put Your Range Here- 

For Each cell In myrange 

    Set Loc = myrange.Cells.Find(What:=cell.Value) 
    Set Loc2 = myrange.FindNext(Loc) 
    If Not Loc2.Address = Loc.Address Then 

     Loc.Offset(0, 1) = 1 

     Do Until Loc2.Address = Loc.Address Or Loc2.Offset(0, 1) = 1 

      Loc2.Offset(0, 1) = 1 
      Set Loc2 = myrange.FindNext(Loc2) 

     Loop 

    End If 

Next cell 

Set Loc = Nothing 
Set Loc2 = Nothing 

End Sub