[数分]：VBA表格合并中的个别情况

[admonition title=” 飞书文档 ” color=”indigo”][VBA] 表格合并中的多种情况 [/admonition]

假设：现在将 n 个人汇总上来的区域销售数据合并，会存在哪些要另行处理的非理想情况？

检查文件是否存在：

Sub TestFilePath()
    Dim folderPath As String
    Dim fileName As String

    folderPath = "D:\ 下载 \ 演示 \ 示例 \"
    fileName = Dir(folderPath & "*.xlsx*")
    
    If fileName = "" Then
        MsgBox "没有找到任何 Excel 文件！"
    Else
        MsgBox "找到的第一个文件名:" & fileName
    End If
End Sub

合并文件路径下的工作簿：

Sub ImportSheetsFromFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim destWorkbook As Workbook
    
    ' 设置文件路径
    folderPath = "D:\ 下载 \ 演示 \ 示例 \"
    
    ' 检查文件夹路径是否存在
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "文件夹路径无效:" & folderPath, vbExclamation
        Exit Sub
    End If
    
     Set destWorkbook = ThisWorkbook
    
   
    fileName = Dir(folderPath & "*.xlsx*")

    Do While fileName <> ""
    
        Set wbSource = Workbooks.Open(folderPath & fileName)
        Set wsSource = wbSource.Sheets(1)
        wsSource.Copy After:=destWorkbook.Sheets(destWorkbook.Sheets.Count)
      
        wbSource.Close SaveChanges:=False
        
        fileName = Dir
    Loop
    
    MsgBox "所有工作表已成功导入！", vbInformation
End Sub

非常规

合并来自不同 sheet 的数据源

Sub MergeColumnsMultipleRanges()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim outputWs As Worksheet
    Dim i As Long, col As Long
    Dim value1 As Variant, value2 As Variant, value3 As Variant
    Dim mergedValue As Variant
    
 
    Set ws1 = ThisWorkbook.Sheets(1) ' 第 1 个 Sheet
    Set ws2 = ThisWorkbook.Sheets(2) ' 第 2 个 Sheet
    Set ws3 = ThisWorkbook.Sheets(3) '第 3 个 Sheet' 创建一个新工作表存放结果
    On Error Resume Next
    Set outputWs = ThisWorkbook.Sheets("合并结果")
    If outputWs Is Nothing Then
        Set outputWs = ThisWorkbook.Sheets.Add
        outputWs.Name = "合并结果"
    End If
    On Error GoTo 0
    outputWs.Cells.Clear
    
    ' 遍历 C 列到 H 列（列数分别是 3 到 8）For col = 2 To 8
        ' 确保遍历 200 行
        For i = 1 To 200
            ' 从第 3 个 Sheet 开始读取
            value3 = ws3.Cells(i, col).Value
            ' 从第 2 个 Sheet 读取
            value2 = ws2.Cells(i, col).Value
            ' 从第 1 个 Sheet 读取
            value1 = ws1.Cells(i, col).Value
            
            ' 合并逻辑：优先级为 Sheet2 > Sheet3 > Sheet1
            If value2 <> "" Then
                mergedValue = value2
            ElseIf value3 <> "" Then
                mergedValue = value3
            ElseIf value1 <> "" Then
                mergedValue = value1
            Else
                mergedValue = "" ' 如果都为空，保留空值
            End If
            
            ' 写入结果到新表
            outputWs.Cells(i, col).Value = mergedValue
        Next i
    Next col
    
    MsgBox "合并完成，结果存放在' 合并结果 '工作表中！"
End Sub