如何用VBA将含字符串与整数的整列去重后转置为行？

Great question—manual row-by-row comparison is brutal for performance, especially with large datasets. Let’s dive into two far more efficient approaches to deduplicate a column of mixed string/integer values and transpose them into a single row.

Method 1: Use Scripting.Dictionary (Fastest Memory-Level Operation) #

The Scripting.Dictionary object is perfect for this task because its keys are inherently unique. It only requires a single pass through your data, and lookups/additions happen in near-instant time (O(1) complexity), making it way faster than nested loops.

Sub UniqueColumnToRow_Dictionary()
    Dim ws As Worksheet
    Dim sourceRange As Range
    Dim cell As Range
    Dim uniqueDict As Object
    Dim targetCell As Range
    
    ' Configure your worksheet and ranges (adjust these to match your file)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set sourceRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Skips header in A1
    Set targetCell = ws.Range("C1") ' Starting cell for transposed unique values
    
    ' Initialize dictionary (late binding—no extra references needed)
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    uniqueDict.CompareMode = vbTextCompare ' Use vbBinaryCompare for case-sensitive deduplication
    
    ' Populate dictionary with unique values (duplicates are auto-ignored)
    For Each cell In sourceRange
        If cell.Value <> "" Then ' Skip empty cells
            uniqueDict(cell.Value) = 1 ' Value can be anything—we only care about the unique keys
        End If
    Next cell
    
    ' Transpose unique keys to target row
    If uniqueDict.Count > 0 Then
        targetCell.Resize(1, uniqueDict.Count).Value = uniqueDict.Keys
    Else
        targetCell.Value = "No non-empty values found"
    End If
    
    ' Cleanup
    Set uniqueDict = Nothing
    Set ws = Nothing
End Sub

Why this works: #

• The dictionary automatically rejects duplicate keys, so you don’t need to write any comparison logic.
• It handles mixed data types (strings, integers, etc.) seamlessly—integer 5 and string "5" are treated as distinct values (adjust if needed by converting all values to strings first).
• Case-insensitive deduplication is enabled by default here; switch to vbBinaryCompare if you need to distinguish between "Apple" and "apple".

Method 2: Use Excel’s Built-in RemoveDuplicates + Transpose #

If you prefer leveraging Excel’s optimized native functions (which are written in C++ under the hood), this approach copies your data to a temporary range, removes duplicates, then transposes the result.

Sub UniqueColumnToRow_BuiltIn()
    Dim ws As Worksheet
    Dim sourceRange As Range
    Dim tempRange As Range
    Dim targetCell As Range
    Dim lastRow As Long
    
    ' Configure your worksheet and ranges
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set sourceRange = ws.Range("A2:A" & lastRow)
    Set targetCell = ws.Range("C1")
    
    ' Use a temporary column (e.g., Column Z) to process deduplication
    Set tempRange = ws.Range("Z2:Z" & lastRow)
    tempRange.Value = sourceRange.Value ' Copy source data to temp
    
    ' Remove duplicates from the temporary range
    tempRange.RemoveDuplicates Columns:=1, Header:=xlNo
    
    ' Transpose cleaned unique values to target row
    Dim uniqueLastRow As Long
    uniqueLastRow = ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row
    If uniqueLastRow >= 2 Then
        ws.Range("Z2:Z" & uniqueLastRow).Copy
        targetCell.PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Else
        targetCell.Value = "No non-empty values found"
    End If
    
    ' Clean up temporary data
    tempRange.ClearContents
    
    ' Cleanup objects
    Set ws = Nothing
    Set sourceRange = Nothing
    Set tempRange = Nothing
End Sub

Why this works: #

• Excel’s RemoveDuplicates is highly optimized for large datasets, so it’s faster than manual VBA loops.
• It’s straightforward to implement if you’re less familiar with dictionaries.
• Note: This method treats integer 5 and string "5" as distinct values (same as the dictionary method) and is case-sensitive by default.

Key Notes #

• Empty Cells: Both methods skip empty cells. If you want to retain a single empty value in your transposed row, adjust the logic to add empty strings to the dictionary or avoid skipping them in the temp range.
• Data Type Consistency: If you need to treat integer 5 and string "5" as identical, convert all values to strings before processing (e.g., uniqueDict(CStr(cell.Value)) = 1 in the dictionary method).

内容的提问来源于stack exchange，提问作者John Smith