如何改进此代码以不删除空单元格，而只是忽略它们？

Question

当我使用我的代码时，我会得到唯一的值。但是其中一个唯一值是空白单元格，并且在粘贴值时代码似乎删除了此单元格。这弄乱了与这些唯一值相关联的公式。

我也想知道如何在 vba 中使用间接函数并将代码链接到两个特定单元格以设置特定范围。如果有人能给我一个很好的答案，我会给予信任。

我还尝试使用以下 excel 公式来获取唯一值： =IFERROR(INDEX(INDIRECT($C$14&"!"&$C$15); MATCH(0;COUNTIF($B$20:B20; INDIRECT($C$14&"!"&$C$15)&"") + IF(间接($C$14&"!"&$C$15) = "";1;0);0));"")

这个公式有效，但我的数据集有点大。因此需要很多时间...

Private Sub Unique_Click()

Dim xRng As Range
Dim xLastRow As Long
Dim xLastRow2 As Long
Dim I As Integer
On Error Resume Next
Set xRng = Application.InputBox("Please select range:", "Kutools for Excel", Selection.Address, , , , , 8)
If xRng Is Nothing Then Exit Sub
On Error Resume Next
xRng.Copy Range("B21")
xLastRow = xRng.Rows.Count + 1
ActiveSheet.Range("B21:B" & xLastRow).RemoveDuplicates Columns:=1, Header:=xlNo
xLastRow2 = Cells(Rows.Count, "B").End(xlUp).Row
For I = 1 To xLastRow2
  If ActiveSheet.Range("B21:B" & xLastRow2).Cells(I).Value = "" Then
     ActiveSheet.Range("B21:B" & xLastRow2).Cells(I).Delete
  End If
Next

End Sub

Answer 1

这将起作用：

Private Sub Unique_Click()

Dim xRng As Range
Dim xLastRow As Long
Dim xLastRow2 As Long
Dim I As Integer
On Error Resume Next
Set xRng = Application.InputBox("Please select range:", "Kutools for Excel", Selection.Address, , , , , 8)
If xRng Is Nothing Then Exit Sub
On Error Resume Next
xRng.Copy Range("B21")
xLastRow = xRng.Rows.Count + 1
ActiveSheet.Range("B21:B" & xLastRow).RemoveDuplicates Columns:=1, Header:=xlNo

End Sub

删除了删除空白单元格的 For 循环

尝试改变

Set xRng = Application.InputBox("Please select range:", "Kutools for Excel", Selection.Address, , , , , 8)

到：

Set xRng = Worksheets("Data1").Range("J3:J45999")