vba 복사 셀 값이 숫자 데이터를 필터링합니다.

Question

문제점이 있습니다. 동적 시트에서 다른 시트로 모든 고유 한 값 (숫자 및 영숫자)을 복사하려고합니다. 나는 포럼에서 위대한 스크립트를 발견했는데, 이것은 빠르게 작동하고 이것을 채택했습니다. 문제는 그것이 모든 숫자 값을 걸러내는 것 같아요. 그리고 저의 삶 때문에 왜 볼 수 없어요! 도울 수 있니?

Sub GetUniqueItems() 
    Dim vData As Variant, n&, lLastRow&, sMsg$ 

    lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value)._ 
    Cells(Rows.Count, "H").End(xlUp).Row 
    If lLastRow = 1 Then Exit Sub '//no data 

    vData = Worksheets(Worksheets("Summary").Range("A1").Value)._ 
    Range("H2:H" & lLastRow) 
    Dim oColl As New Collection 
    On Error Resume Next 
    For n = LBound(vData) To UBound(vData) 
    oColl.Add vData(n, 1), vData(n, 1) 
    Next 'n 

    For n = 1 To oColl.Count 
    sMsg = oColl(n) 
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1) 
    Next 'n 

    End Sub 

Answer 1

Collection 항목의 키는 문자열이어야합니다. 이것에

oColl.Add vData(n, 1), vData(n, 1) 

: 그래서이 줄을 변경 당신이 그렇게 코드가 컬렉션에 중복을 추가하려는 시도를 skip over 것 On Error Resume Next을 필요로하지만, 또한

oColl.Add vData(n, 1), CStr(vData(n, 1)) 

을, 당신은 단지 그것을 위해 그것을 사용한다 한 줄. 그렇지 않으면 코드의 다른 오류를 마스킹 할 위험이 있습니다. (코드가 런타임 오류를 가지고 있지 않은 이유는 중복을 우회의 직업 수행에 추가하여 On Error Resume Next 때문이었고, 또한 숫자 Keys 어떤 Adds을 스킵되었다. 이러한 이유로

, 나는에 라인을 이동 는 oColl.Add 및 On Error Goto 0을 추가 한 직후 바로 전에 :

여기 루틴 가득 :

Sub GetUniqueItems() 
Dim vData As Variant, n&, lLastRow&, sMsg$ 
Dim oColl As Collection 

lLastRow = Worksheets(Worksheets("Summary").Range("A1").Value).Cells(Rows.Count, "H").End(xlUp).Row 
If lLastRow = 1 Then Exit Sub 

vData = Worksheets(Worksheets("Summary").Range("A1").Value).Range("H2:H" & lLastRow) 
Set oColl = New Collection 
For n = LBound(vData) To UBound(vData) 
    On Error Resume Next 
    oColl.Add vData(n, 1), CStr(vData(n, 1)) 
    On Error GoTo 0 
Next n 

For n = 1 To oColl.Count 
    sMsg = oColl(n) 
    Sheets("Summary").Cells(n + 3, 1).Value = Mid$(sMsg, 1) 
Next n 
End Sub 

마지막으로 한가지 : 당신이 Dim oColl As New Collection처럼 문을 피하고, 대신 선언 및 I로 두 단계를 설정하려면 그랬어. 이유는 Chip Pearson page을 참조하고 "자동 인스턴스화 객체 변수 사용 안 함"으로 스크롤하십시오.

Answer 2

OP 등에서 흥미로울 수있는 코드를 아래에 표시하고 있으며 데이터 열에서 고유 한 목록을 얻는 효율적인 방법입니다.

Excel 2007 이상에서는 열을 복사하고 Remove Duplicates 기능을 사용하여 고유 목록을 얻을 수 있습니다.

Sub CreateUniqueList() 
    Dim lLastRow As Long 
    Dim wsSum As Worksheet 
    Dim rng As Range 

    Set wsSum = Worksheets("Summary") 
    lLastRow = wsSum.Cells(Rows.Count, "H").End(xlUp).Row 
    If lLastRow = 1 Then Exit Sub 

    wsSum.Range("H2:H" & lLastRow).Copy wsSum.Cells(4, 1) 
    wsSum.Range(wsSum.Cells(4, 1), wsSum.Cells(4 + lLastRow - 2, 1)). _ 
     RemoveDuplicates Columns:=1, Header:=xlNo 
End Sub 

유일한 약간의 단점

우리가 먼저 전체 열을 복사해야한다는 것입니다, 그러나 이것은 큰 데이터 세트에 대한 성능 향상에 비해 작은 것입니다.