programing

VBA에서 열의 모든 고유한 값을 빠르게 가져올 수 있는 방법?

megabox 2023. 4. 9. 21:18
반응형

VBA에서 열의 모든 고유한 값을 빠르게 가져올 수 있는 방법?

더 빠른 방법은 없나요?

Set data = ws.UsedRange

Set unique = CreateObject("Scripting.Dictionary")

On Error Resume Next
For x = 1 To data.Rows.Count
    unique.Add data(x, some_column_number).Value, 1
Next x
On Error GoTo 0

이 시점에서unique.keys필요한 것은 얻었지만 수만 개의 레코드가 있는 파일에서는 루프 자체가 매우 느린 것 같습니다(특히 Python이나 C++와 같은 언어에서는 문제가 되지 않습니다).

이를 수행하려면 Excel의 AdvancedFilter 함수를 사용하십시오.

Excels 내장 C++를 사용하는 것이 소규모 데이터셋에서는 가장 빠른 방법이며, 대규모 데이터셋에서는 사전을 사용하는 것이 더 빠릅니다.예를 들어 다음과 같습니다.

A열에 값을 복사하고 B열에 원하는 값을 삽입합니다.

Range("A1:A6").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

여러 열에서도 사용할 수 있습니다.

Range("A1:B4").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1:E1"), Unique:=True

열이 여러 개일 경우 항상 예상대로 작동하지 않으므로 주의하십시오.이 경우 중복을 제거하여 고유성을 기준으로 사용할 열을 선택합니다.참조: MSDN - 중복 검색 및 삭제

여기에 이미지 설명 입력

여기서는 세 번째 열을 기준으로 중복 열을 제거합니다.

Range("A1:C4").RemoveDuplicates Columns:=3, Header:=xlNo

여기서 두 번째 및 세 번째 열을 기준으로 중복 열을 제거합니다.

Range("A1:C4").RemoveDuplicates Columns:=Array(2, 3), Header:=xlNo

배열에 값을 로드하는 것이 훨씬 빠릅니다.

Dim data(), dict As Object, r As Long
Set dict = CreateObject("Scripting.Dictionary")

data = ActiveSheet.UsedRange.Columns(1).Value

For r = 1 To UBound(data)
    dict(data(r, some_column_number)) = Empty
Next

data = WorksheetFunction.Transpose(dict.keys())

또한 스크립팅의 조기 바인딩을 고려해야 합니다.사전:

Dim dict As New Scripting.Dictionary  ' requires `Microsoft Scripting Runtime` '

사전을 사용하는 것이 Range보다 훨씬 빠릅니다.대규모 데이터 세트의 AdvancedFilter.

보너스로, 여기 레인지와 비슷한 절차가 있습니다.2D 어레이에서 중복을 제거하기 위한 중복 제거:

Public Sub RemoveDuplicates(data, ParamArray columns())
    Dim ret(), indexes(), ids(), r As Long, c As Long
    Dim dict As New Scripting.Dictionary  ' requires `Microsoft Scripting Runtime` '

    If VarType(data) And vbArray Then Else Err.Raise 5, , "Argument data is not an array"

    ReDim ids(LBound(columns) To UBound(columns))

    For r = LBound(data) To UBound(data)         ' each row '
        For c = LBound(columns) To UBound(columns)   ' each column '
            ids(c) = data(r, columns(c))                ' build id for the row
        Next
        dict(Join$(ids, ChrW(-1))) = r  ' associate the row index to the id '
    Next

    indexes = dict.Items()
    ReDim ret(LBound(data) To LBound(data) + dict.Count - 1, LBound(data, 2) To UBound(data, 2))

    For c = LBound(ret, 2) To UBound(ret, 2)  ' each column '
        For r = LBound(ret) To UBound(ret)      ' each row / unique id '
            ret(r, c) = data(indexes(r - 1), c)   ' copy the value at index '
        Next
    Next

    data = ret
End Sub

PowerShell은 매우 강력하고 효율적인 도구입니다.이는 다소 부정 행위이지만 VBA를 통해 PowerShell을 포격하면 많은 옵션이 열립니다.

아래 코드의 대부분은 단순히 현재 시트를 CSV 파일로 저장하는 것입니다.출력은 고유한 값만 포함하는 다른 csv 파일입니다.

Sub AnotherWay()
Dim strPath As String
Dim strPath2 As String

Application.DisplayAlerts = False
strPath = "C:\Temp\test.csv"
strPath2 = "C:\Temp\testout.csv"
ActiveWorkbook.SaveAs strPath, xlCSV
x = Shell("powershell.exe $csv = import-csv -Path """ & strPath & """ -Header A | Select-Object -Unique A | Export-Csv """ & strPath2 & """ -NoTypeInformation", 0)
Application.DisplayAlerts = True

End Sub

몇 번이고 이 설명서를 읽어야 했기 때문에 재미있지만, 훨씬 더 빠른 방법을 알아낸 것 같아요.

Set data = ws.UsedRange
dim unique as variant
unique = WorksheetFunction.Unique(data)

그리고 네가 하고 싶은 대로 할 수 있어unique어레이(예: 반복):

For i = LBound(unique) To UBound(unique)
    Range("Q" & i) = indexes(i, 1)
Next

이거 드셔보세요

Option Explicit

Sub UniqueValues()
Dim ws As Worksheet
Dim uniqueRng As Range
Dim myCol As Long

myCol = 5 '<== set it as per your needs
Set ws = ThisWorkbook.Worksheets("unique") '<== set it as per your needs

Set uniqueRng = GetUniqueValues(ws, myCol)

End Sub


Function GetUniqueValues(ws As Worksheet, col As Long) As Range
Dim firstRow As Long

With ws
    .Columns(col).RemoveDuplicates Columns:=Array(1), header:=xlNo

    firstRow = 1
    If IsEmpty(.Cells(1, col)) Then firstRow = .Cells(1, col).End(xlDown).row

    Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp))
End With

End Function

NeepNeepNeep이 말한 것은 매우 빠르고 단점도 없을 것이다.

언급URL : https://stackoverflow.com/questions/36044556/quicker-way-to-get-all-unique-values-of-a-column-in-vba

반응형