[数分]:VBA表格合并中的个别情况
本文最后更新于31 天前,如有版本迭代或环境切变,可告知邮箱到xianghy_m@sina.com指正修改。

假设:现在将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

文末附加内容
暂无评论

发送评论 编辑评论


				
|´・ω・)ノ
ヾ(≧∇≦*)ゝ
(☆ω☆)
(╯‵□′)╯︵┴─┴
 ̄﹃ ̄
(/ω\)
∠( ᐛ 」∠)_
(๑•̀ㅁ•́ฅ)
→_→
୧(๑•̀⌄•́๑)૭
٩(ˊᗜˋ*)و
(ノ°ο°)ノ
(´இ皿இ`)
⌇●﹏●⌇
(ฅ´ω`ฅ)
(╯°A°)╯︵○○○
φ( ̄∇ ̄o)
ヾ(´・ ・`。)ノ"
( ง ᵒ̌皿ᵒ̌)ง⁼³₌₃
(ó﹏ò。)
Σ(っ °Д °;)っ
( ,,´・ω・)ノ"(´っω・`。)
╮(╯▽╰)╭
o(*////▽////*)q
>﹏<
( ๑´•ω•) "(ㆆᴗㆆ)
😂
😀
😅
😊
🙂
🙃
😌
😍
😘
😜
😝
😏
😒
🙄
😳
😡
😔
😫
😱
😭
💩
👻
🙌
🖕
👍
👫
👬
👭
🌚
🌝
🙈
💊
😶
🙏
🍦
🍉
😣
Source: github.com/k4yt3x/flowerhd
颜文字
Emoji
小恐龙
花!
上一篇
下一篇