当前位置：首页 > article >正文

【EXCEL_VBA_实战】多工作薄合并深入理解

article 2025/1/23 21:38:38

工作背景：多个工作薄存在冲突的名称，需快速合并

困难点：工作表移动复制时，若有冲突的名称，会不断弹出对话框待人工确认

思路：利用代码确认弹出的对话框

关键代码：Application.DisplayAlerts = False

Sub Merge_WB()
'文件合并

Dim WBs_Source As Variant '工作薄序列
Dim s As Integer '工作薄序列下标

'选择工作薄（）
WBs_Source = Application.GetOpenFilename(fileFilter:="xlsx文件(*.xls*),*.xls*", Title:="选择Excel文件", MultiSelect:=True)
If TypeName(WBs_Source) = "Boolean" Then Exit Sub

Dim WB_Source As Workbook
Dim WS_Source As Worksheet

' 打开工作簿
For s = 1 To UBound(WBs_Source)
    
    '设定当前打开工作簿名称为WB_Source 
    Workbooks.Open WBs_Source(s), UpdateLinks:=0 '不更新外部链接
    Set WB_Source = GetObject(WBs_Source(s))
    
    '逐一复制粘贴工作表
    
    '重要代码，避免工作表复制过程中名称冲突
    '下行代码可以默认确认EXCEL弹出的对话框（不用手动逐个点击）
    Application.DisplayAlerts = False
    
    For Each WS_Source In WB_Source.Sheets
        WS_Source.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Next
    Application.DisplayAlerts = Ture
    
    '关闭源工作簿
    WB_Source.Close SaveChanges:=False
    
    '删除当前工作薄的无效名称
    AvoidingNameInvalid WB_Source:=ThisWorkbook
    
Next

End Sub

Function AvoidingNameInvalid(WB_Source As Workbook)
'删除当前工作薄的无效名称

    Dim nmSource As Name
    
    '删除当前打开工作薄的无效名称
    For Each nmSource In WB_Source.Names
    
        If InStr(1, nmSource.RefersTo, "#REF!") > 0 Then
        
            On Error Resume Next ' 忽略错误，以防删除时出现问题
            
            Debug.Print nmSource.Name & ": deleted" '在立即窗口查看即将删除的名称
            nmSource.Delete
            
            On Error GoTo 0 ' 恢复正常的错误处理
            
        End If
        
        
    Next nmSource
    
End Function

查看全文

http://www.kler.cn/a/515424.html