Vba 从范围中删除重复项始终在末尾保留一个空白单元格

作为更大宏的一部分，我尝试将一个范围从一个工作表复制到另一个工作表，删除重复项，并将剩余的唯一值设置为一个范围。我已经写了以下原则上有效的内容，但在删除重复项并将剩余单元格设置为一个区域后，该区域中的最后一个单元格始终为空。如何忽略此空白单元格，使我的范围位于唯一值上

lr = Data.Cells(Rows.Count, "B").End(xlUp).Row
Data.Range("B5:B" & lr).Copy Sheets("Index").Range("B1")
Sheets("Index").Range("B1:B10000").Copy
Sheets("Index").Range("B1").PasteSpecial xlPasteValues
Sheets("Index").Range("B1:B10000").RemoveDuplicates Columns:=1, Header:=xlNo
Application.CutCopyMode = False
lr = Sheets("Index").Cells(Rows.Count, "B").End(xlUp).Row
Set MCH = Sheets("Index").Range("B1:B" & lr)

---

仅供参考，我之所以复制具有范围的粘贴值，是因为它复制了一个包含两个名称的“helper”列，如果不这样做，我的宏将无法工作。如果有更有效的方法，我洗耳恭听。

如果列中的单元格在删除重复项之前包含空值；删除重复项后，列中至少会有一个包含Null的单元格

---

您可以在之后删除空值。

正如Gary的学生所指出的，硬编码范围内将有一个空行

“B1:B10000”

再次尝试使用最后一行逻辑调整10000-我认为当您从

B5

粘贴时，您可以从

lr

调整到

（lr+4）

：

lr = Data.Cells(Rows.Count, "B").End(Excel.xlUp).Row
Data.Range("B5:B" & lr).Copy Sheets("Index").Range("B1")
Sheets("Index").Range("B1:B" & (lr+4)).Copy
Sheets("Index").Range("B1").PasteSpecial Excel.xlPasteValues
Sheets("Index").Range("B1:B" & (lr+4)).RemoveDuplicates Columns:=1, Header:=Excel.xlNo
Excel.Application.CutCopyMode = False
lr = Sheets("Index").Cells(Rows.Count, "B").End(Excel.xlUp).Row
Set MCH = Sheets("Index").Range("B1:B" & lr)

一种非常不同但更漂亮的方法是使用如下数组和集合：

Sub unique()
  Dim arr As New Collection, a
  Dim aFirstArray() As Variant
  Dim i As Long

  Dim Data as Excel.worksheet
  Set Data = Thisworkbook.sheets("Data")

  lr = Data.Cells(Rows.Count, 2).End(Excel.xlUp).Row
  aFirstArray() = Data.Range("B5:B" & lr)

  On Error Resume Next
  For Each a In aFirstArray
     arr.Add a, a
  Next

  For i = 1 To arr.Count
     Sheets("Index").Cells(i, 2) = arr(i)
  Next

End Sub

阵列速度非常快——我想这也会更快

我希望第二个scipt是我的原始代码，但它是一个改编。参考资料：

---

更加优雅，谢谢您的帮助！我确实注意到我必须用aFirstArray替换aFirstArray（），以使其工作，但之后速度会快得多。