[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