VBA数据清洗问题：去重去空失效及代码优化咨询

我来帮你搞定这两个问题，先上修改后的完整宏代码，再逐点解释优化细节：

Sub Clean_Data()
    Dim wsDB As Worksheet, wsDest As Worksheet
    Dim sourceRange As Range, destRange As Range
    Dim lastRow As Long
    
    ' 初始化工作表对象（根据你的实际表名调整）
    Set wsDB = ThisWorkbook.Worksheets("DB")
    Set wsDest = ThisWorkbook.Worksheets("Destination")
    
    ' 清空目标表旧数据，避免干扰新结果
    wsDest.Cells.Clear
    
    ' 定位DB表中指定列的有效数据（假设多表头后从第3行开始，目标列为C列，按需修改）
    lastRow = wsDB.Cells(wsDB.Rows.Count, "C").End(xlUp).Row
    Set sourceRange = wsDB.Range("C3:C" & lastRow)
    
    ' 仅复制值到目标表，彻底去除原格式
    Set destRange = wsDest.Range("A1").Resize(sourceRange.Rows.Count, 1)
    destRange.Value = sourceRange.Value
    
    ' 合并去重、排序、去空操作，只用一个With块
    With destRange
        ' 去重：针对当前列，无表头
        .RemoveDuplicates Columns:=1, Header:=xlNo
        
        ' 排序：非空值升序排列，空值自动排到末尾
        .Sort Key1:=.Cells(1), Order1:=xlAscending, _
              Header:=xlNo, OrderCustom:=1, _
              MatchCase:=False, Orientation:=xlTopToBottom, _
              DataOption1:=xlSortNormal
        
        ' 删除排序后的空行（如果存在）
        lastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
        If lastRow < .Rows.Count Then
            wsDest.Range("A" & lastRow + 1 & ":A" & .Rows.Count).Delete Shift:=xlUp
        End If
    End With
    
    MsgBox "数据提取完成！", vbInformation
End Sub

针对你的问题的具体解决方案 #

1. 修复排序去空无效的问题 #

原代码的排序失效大概率是因为范围错误或未明确空值处理逻辑：

• 这里的Sort操作明确以目标列为排序关键字，升序排列时空值会自动被推到所有非空值的后面，解决了空值无法被区分的问题。
• 排序后通过End(xlUp)定位最后一个非空行，直接删除后面的空行，确保最终结果只保留唯一非空值。

2. 合并去重与排序的代码块 #

我把去重、排序、去空操作都包裹在一个With destRange块中：

• 所有操作都直接针对目标范围，不用重复写destRange.xxx，减少冗余代码，让逻辑更紧凑。
• 避免了多次调用With语句，提升代码的可读性和维护性。

额外注意事项 #

• 如果你的多表头行数不是2行（即数据不是从第3行开始），请修改sourceRange的起始行（比如改成C2:C" & lastRow）。
• 如果目标列不是C列，把代码中的"C"替换成你需要提取的列字母或列号。
• 清空目标表数据的步骤是为了确保每次运行宏都得到全新的结果，避免旧数据残留。

内容的提问来源于stack exchange，提问作者Martim On Fire