Question

使用代码时，我得到唯一的值。但是唯一值之一是空白单元格，并且粘贴了值后，代码似乎删除了该单元格。这弄乱了与这些唯一值链接的公式。

我还想知道如何在vba中使用间接函数并将代码链接到两个特定的单元格以设置特定的范围。如果有人可以给我所有这些的很好的答案，我将不负任何责任。

我还尝试使用以下excel公式来获取唯一值： = IFERROR（INDEX（INDIRECT（$ C $ 14＆“！”＆$ C $ 15）; MATCH（0; COUNTIF（$ B $ 20：B20; INDIRECT（$ C $ 14＆“！”＆$ C $ 15）＆“”）） + IF（INDIRECT（$ 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

对于删除了空白单元格的循环已删除

尝试更改

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

收件人：

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

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

1 个答案: