Excel VBA RemoveDuplicates 함수에서 대/소문자 구분을 사용합니다.

Question

선택한 열에서 일부 중복을 제거하려고 시도하지만이 함수는 대소 문자에 관계없이 모든 복제본을 제거합니다. RemoveDuplicates은 소문자, 대문자 등을 중복으로 간주합니다. 예 : 함수는 CENTRAL, central 및 Central을 제거했습니다.

다음 코드를 기록하고 조금 변경했습니다. 다른 케이스로 항목을 보관해야하며 중복으로 제거하고 싶지 않습니다.

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Keyboard Shortcut: Ctrl+q 
' 
    ActiveWorkbook.Sheets(3).Range("A:A").Clear 
    Selection.Copy 
    Sheets("Sheet3").Select 
    Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.RemoveDuplicates Columns:=1, Header:=xlNo 
    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=True 
    'Range("B12").Select 
    Selection.End(xlToRight).Select 
    ActiveWorkbook.Sheets(3).Range("A:A").Clear 
End Sub 

Answer 1

는 대소 문자 구분과 중복을 제거하는 Dictionary를 사용하여 다음 코드를 사용해보십시오 :

는

Option Explicit 

Sub Test() 
    RemoveDuplicates Sheet1.Range("A1:A12") 
End Sub 

Sub RemoveDuplicates(rngDataColumn As Range) 
'assumes rngDataColumn is a column of data 

    Dim dic As Object 
    Dim rngCell As Range 
    Dim varKey As Variant 
    Dim lngCounter As Long 

    'create dictionary 
    Set dic = CreateObject("Scripting.Dictionary") 

    'dictionary becomes case sensitive 
    dic.CompareMode = vbBinaryCompare 

    'iterate range for unique values 
    For Each rngCell In rngDataColumn 
     If Not dic.Exists(rngCell.Value) Then 
      dic.Add Key:=rngCell.Value, Item:=True 
     End If 
    Next rngCell 

    'clear source range 
    rngDataColumn.ClearContents 

    'output unique items - with case sensitivity 
    lngCounter = 1 
    For Each varKey In dic.Keys 
     rngDataColumn(lngCounter, 1).Value = varKey 
     lngCounter = lngCounter + 1 
    Next varKey 

End Sub 

A1 : A12 다음 내 테스트 케이스에서와 같이 : 그래서

, 기록 된 매크로를 업데이트하려면 다음을 시도해보십시오.

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Keyboard Shortcut: Ctrl+q 
' 
    ActiveWorkbook.Sheets(3).Range("A:A").Clear 
    Selection.Copy 
    Sheets("Sheet3").Select 
    Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 

    'use the new function here 
    RemoveDuplicates Selection 
    'Selection.RemoveDuplicates Columns:=1, Header:=xlNo 

    Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 
    Sheets("Sheet2").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=True 
    'Range("B12").Select 
    Selection.End(xlToRight).Select 
    ActiveWorkbook.Sheets(3).Range("A:A").Clear 
End Sub 

Answer 2

나는 here을 발견했으며, 기대했던 바를 충족시키는 멋진 솔루션을 테스트했습니다. 이 함수를 프로젝트에 붙여 넣어야합니다.

Option Compare Binary 
Sub deleteExactDuplicates(ByVal rng As Range) 
    Application.ScreenUpdating = False 
    With CreateObject("scripting.dictionary") 
     For Each i In rng.Cells 
      v = i.Value 
      If .exists(v) Then 
       i.ClearContents 
      Else 
       .Add v, 1 
      End If 
     Next i 
    End With 
    On Error Resume Next 
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
End Sub 

그런 다음 코드에서 호출해야합니다. 내가 이해한다면, 당신은 선택의 범위에서 중복을 제거 할, 그래서 매크로는 다음과 같이 보일 것이다 : 이제

Sub test() 
    deleteExactDuplicates Selection 
End Sub 

이이 솔루션은 중복 값이 ​​발생뿐만 아니라 선택된 범위의 값뿐만 아니라 전체 행을 삭제 . 그걸로 괜찮습니까? 아니면 특정 범위에서만 복제본을 제거해야 할 필요가 있습니까?