请求合并Excel宏：实现A列非空单元格复制去重并插入D列下移

完整可运行代码 #

Sub ProcessBookingData()
    Dim bookingWS As Worksheet
    Dim sourceRng As Range, copyRng As Range
    Dim dataArr As Variant, filteredArr As Variant
    Dim i As Long, count As Long
    
    ' 绑定目标工作表，避免重复查找
    Set bookingWS = ThisWorkbook.Sheets("Booking Sheet")
    
    ' 定义源数据范围并读取到数组（提升效率）
    Set sourceRng = bookingWS.Range("A1:A20")
    dataArr = sourceRng.Value
    
    ' 过滤非空单元格（含空格处理）
    ReDim filteredArr(1 To UBound(dataArr, 1))
    count = 0
    For i = 1 To UBound(dataArr, 1)
        If Trim(dataArr(i, 1)) <> "" Then
            count = count + 1
            filteredArr(count) = dataArr(i, 1)
        End If
    Next i
    
    ' 清空B列旧数据，写入过滤后内容
    bookingWS.Range("B1:B20").ClearContents
    If count > 0 Then
        bookingWS.Range("B1").Resize(count, 1).Value = Application.Transpose(filteredArr)
        ' 去重：若B1是标题则改为Header:=xlYes，否则用xlNo
        bookingWS.Range("B1:B" & count).RemoveDuplicates Columns:=1, Header:=xlNo
    End If
    
    ' 获取B列处理后的有效数据范围
    Set copyRng = bookingWS.Range("B1", bookingWS.Range("B1").End(xlDown))
    ' 插入对应行数到D列，原有内容下移
    bookingWS.Range("D1:D" & copyRng.Rows.Count).Insert Shift:=xlDown
    ' 复制数据到D列
    copyRng.Copy bookingWS.Range("D1")
End Sub

关键修改与优化说明 #

• 统一工作表引用：用bookingWS变量绑定目标工作表，避免重复调用Sheets("Booking Sheet")，提升效率且减少错误
• 严谨空值过滤：增加Trim()处理空格型空值，避免误判看似为空实则有空格的单元格
• 精确范围操作：去重时使用B1:B&count而非固定B1:B20，只处理有效数据行；插入D列时用实际数据行数，避免多插空行
• 状态重置：写入B列前先清空原有内容，避免旧数据干扰后续处理
• 连贯执行逻辑：将两个独立宏的流程合并为一个过程，保证数据处理的顺序性，避免单独运行时的状态依赖问题

原代码整合失败的常见原因 #

1. 范围引用错误：原代码中RemoveDuplicates使用固定B1:B20，去重后B列存在空行，导致第二个宏中End(xlDown)无法正确定位有效数据末尾
2. Header参数误用：RemoveDuplicates的Header:=xlYes会将B1视为标题行跳过，若B1是数据而非标题，会导致第一行数据被忽略
3. 未清空旧数据：多次运行时B列残留旧数据，导致复制范围包含无效内容
4. 变量作用域问题：直接粘贴两个Sub的代码时，未定义共享变量或未处理执行顺序，导致中间状态异常

内容的提问来源于stack exchange，提问作者thyestes