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
'programing' 카테고리의 다른 글
64비트 Windows에서의 cURL 실행 (0) | 2023.04.09 |
---|---|
GUID의 SCOPE_IDENTITY()? (0) | 2023.04.09 |
URL에서 문자열을 인코딩하려면 (0) | 2023.04.09 |
작업 스케줄러 태스크가 오류 2147942667로 실패하는 이유는 무엇입니까? (0) | 2023.04.09 |
엑셀 1시간 추가 (0) | 2023.04.09 |