筛选唯一值并将A排序为Z Excel VBA

问题描述：

我一直在使用以下代码从 Sheet1 过滤唯一值并将其粘贴到 Sheet2 中，我的代码工作正常.但是它有一个问题，就是当我从Sheet1.Range(C4:C)单元格中删除任何值时，它会在 Sheet2 中提供空单元格，如下图所示.

I have been using below code to Filter the Unique values from Sheet1 and paste them into Sheet2 my code is working fine. But it has one issue that is when i remove any value from Sheet1.Range(C4:C) cell it gives empty cell in Sheet2 like in below image.

我希望如果我从Sheet1范围中删除任何单元格值，则代码应自动对其进行调整.在Sheet2范围内不应有任何空白单元格.

I want that if i remove any cell value from Sheet1 range then Code should automatically adjust it. there should not be any empty cell in Sheet2 Range.

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

I also wants to add sort function in the code so unique values will be popup with sorting A to Z in sheet2.

我尽力做到两件事，但不能做到.在这方面您的帮助将受到高度赞赏.

I tried at my end to do both things but cannot do. Your help in this regard will be highly appreciated.

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对数组进行排序:

You'll need also this UDF to sort arrays:

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)是:

My source sheet (your Sheet1) is:

当执行代码时，在我的命运表(您的sheet2)中，我得到:

And when executing code, in my destiny sheet (your sheet2) I get:

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

All data sorted and no blanks :)

希望您可以使其适应您的需求.

Hope you can adapt this to your needs.

关于对数组进行排序的功能，所有功劳归作者: https://stackoverflow.com/a/152325/9199828

about function to sort arrays, all credits go to author: https://stackoverflow.com/a/152325/9199828

筛选唯一值并将A排序为Z Excel VBA

相关推荐