excel - 过滤唯一值并从 A 到 Z Excel VBA 排序

Question

我一直在使用下面的代码来过滤来自 Sheet1 的唯一值并将它们粘贴到 Sheet2 我的代码工作正常。
但它有一个问题，即当我从 Sheet1.Range(C4:C) 单元格中删除任何值时，它会在 Sheet2 中给出空单元格，如下图所示。
我希望如果我从 Sheet1 范围中删除任何单元格值，那么代码应该自动调整它。 Sheet2 Range 中不应有任何空单元格。
我还想在代码中添加排序功能，以便在 sheet2 中通过从 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

Answer 1

这是我使用的代码:

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