Question

作为较大宏的一部分，我正在尝试将范围从一个工作表复制到另一个工作表，删除重复项，并将剩余的唯一值设置为范围。我写了下面的原则，但在删除重复项并将剩余的单元格设置为范围后，范围中的最后一个单元格始终是空白单元格。如何忽略此空白单元格，因此我的范围是唯一值？

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)

仅供参考我之所以使用该范围复制粘贴值是因为它复制了一个包含2个名称的“帮助”列，而我的宏在没有这样做的情况下无效。如果有更有效的方式，我会全力以赴。

Answer 1

正如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

阵列非常快 - 我想这也会更快。

我希望第二篇文章是我原来的一段代码，但它是一个改编版。参考：
vba: get unique values from array

Answer 2

如果删除重复项之前，列中的单元格包含 Nulls ;然后，在删除重复项后，至少有一个包含 Null 的单元格将在列中。

之后您可以删除 Null 。

从Range中删除重复项总是在末尾留下1个空白单元格

2 个答案: