过滤唯一值并对 A 到 Z 进行排序 Excel VBA

我一直在使用下面的代码来过滤唯一值Sheet1并将它们粘贴到Sheet2我的代码工作正常。 但它有一个问题，当我从 Sheet1.Range(C4:C) 单元格中删除任何值时，它会给出空单元格Sheet2就像下面的图片一样。

我希望如果我从 Sheet1 范围中删除任何单元格值，那么代码应该自动调整它。 Sheet2 范围中不应有任何空单元格。

我还想在代码中添加排序功能，以便在工作表 2 中按 A 到 Z 排序时会弹出唯一值。

我最终尝试做这两件事，但都做不到。我们将非常感谢您在这方面的帮助。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim d As Object, c As Variant, i As Long, lr As Long
Set d = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, 1).End(xlUp).Row
c = Sheet1.Range("C4:C" & lr)
For i = 1 To UBound(c, 1)
  d(c(i, 1)) = 1
Next i
Sheet2.Range("C4").Resize(d.Count) = Application.Transpose(d.keys)
End Sub

这是我使用过的代码：

Sub test()
Dim WkSource As Worksheet
Dim WkDestiny As Worksheet
Dim MiMatriz() As Variant
Dim LR As Long
Dim i As Long
Dim ZZ As Long

Set WkSource = ThisWorkbook.Worksheets("source") 'Replace SOURCE with name of your Sheet1
Set WkDestiny = ThisWorkbook.Worksheets("destiny") 'Replace DESTINY with name of your sheet2

With WkSource
    LR = .Cells(.Rows.Count, 3).End(xlUp).Row 'Last non empty cell in colum C
    ReDim MiMatriz(1 To LR - 4 + 1) 'we do LR-4 because your data starts at row 4, and we add 1
    ZZ = 1
    For i = 4 To LR Step 1
        MiMatriz(ZZ) = .Range("C" & i).Value
        ZZ = ZZ + 1
    Next i
End With

'sort
Call QuickSort(MiMatriz, 1, UBound(MiMatriz))

'paste

'we paste array, excluding blanks
ZZ = 4 'starting at row 4
For i = 1 To UBound(MiMatriz) Step 1
    If MiMatriz(i) <> "" Then
        WkDestiny.Range("C" & ZZ).Value = MiMatriz(i)
        ZZ = ZZ + 1
    End If
Next i


'Remove duplicates
WkDestiny.Range("C4:C" & ZZ - 1).RemoveDuplicates Columns:=1, Header:=xlNo

Erase MiMatriz
Set WkSource = Nothing
Set WkDestiny = Nothing

End Sub

您还需要这个 UDF 来对数组进行排序：

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow + inHi) \ 2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow + 1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow + 1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

我的源表（您的 Sheet1）是：

当执行代码时，在我的命运表（你的sheet2）中我得到：

所有数据均已排序，没有空白:)

希望您能根据您的需要进行调整。

关于数组排序函数，所有功劳归作者所有：https://stackoverflow.com/a/152325/9199828 https://stackoverflow.com/a/152325/9199828