使用VBA合并多列数据到新工作表 按优先级填充供应商信息

实现逻辑 #

• 批量读取原始工作表数据存入数组，避免逐行操作单元格大幅提升运行效率
• 按要求的优先级判断三家公司的对应字段：优先取Yonitech（D/E/F列），为空则取Aliworld（H/I/J列），仍为空则取Lanck（K/L/M列）
• 所有行处理完成后一次性写入新工作表，自动设置表头和列宽

完整VBA代码 #

Sub 导出优先级匹配数据()
    Dim srcSht As Worksheet, newSht As Worksheet
    Dim lastRow As Long, i As Long, arr As Variant, resArr As Variant
    
    ' 此处修改为你的原始工作表实际名称
    Set srcSht = ThisWorkbook.Worksheets("原始数据")
    ' 获取原始表最后一行行号
    lastRow = srcSht.Cells(srcSht.Rows.Count, "A").End(xlUp).Row
    ' 读取全量原始数据到数组
    arr = srcSht.Range("A1:M" & lastRow).Value
    ' 定义结果数组，共6列
    ReDim resArr(1 To UBound(arr, 1), 1 To 6)
    
    ' 写入结果表头
    resArr(1, 1) = "国家名称"
    resArr(1, 2) = "国家ID"
    resArr(1, 3) = "订阅用户数"
    resArr(1, 4) = "供应商名称"
    resArr(1, 5) = "成本"
    resArr(1, 6) = "转化率"
    
    ' 循环处理每行数据，默认第1行为表头，从第2行开始处理
    For i = 2 To UBound(arr, 1)
        ' 前三列直接复制原始数据
        resArr(i, 1) = arr(i, 1)
        resArr(i, 2) = arr(i, 2)
        resArr(i, 3) = arr(i, 3)
        
        ' 供应商名称优先级判断
        If arr(i, 4) <> "" Then
            resArr(i, 4) = arr(i, 4)
        ElseIf arr(i, 8) <> "" Then
            resArr(i, 4) = arr(i, 8)
        Else
            resArr(i, 4) = arr(i, 11)
        End If
        
        ' 成本优先级判断
        If arr(i, 5) <> "" Then
            resArr(i, 5) = arr(i, 5)
        ElseIf arr(i, 9) <> "" Then
            resArr(i, 5) = arr(i, 9)
        Else
            resArr(i, 5) = arr(i, 12)
        End If
        
        ' 转化率优先级判断
        If arr(i, 6) <> "" Then
            resArr(i, 6) = arr(i, 6)
        ElseIf arr(i, 10) <> "" Then
            resArr(i, 6) = arr(i, 10)
        Else
            resArr(i, 6) = arr(i, 13)
        End If
    Next i
    
    ' 新建工作表存放结果，自动按时间命名避免重名
    Set newSht = ThisWorkbook.Worksheets.Add(After:=srcSht)
    newSht.Name = "匹配结果_" & Format(Now(), "YYYYMMDDHHMMSS")
    ' 批量写入结果数据
    newSht.Range("A1").Resize(UBound(resArr, 1), 6).Value = resArr
    ' 自动调整列宽
    newSht.Columns("A:F").AutoFit
    
    MsgBox "数据处理完成，结果已保存至工作表：" & newSht.Name, vbInformation
End Sub

使用注意事项 #

• 运行代码前请先备份原始Excel文件，避免误操作导致数据丢失
• 如果原始工作表名称不是原始数据，请将代码中对应位置的工作表名称修改为你实际使用的名称
• 如果原始表表头行数不是1行，请调整代码中循环的起始行数值

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