销管佳·汽车综合营销生态系统使用手册

相同表格表头合并



 1、将多个excel的文件合并在一个excel文件的不同sheet中。

(1)首先,我们在Epan下的vb文件夹中创建4个excel文件

(2)新建文件excel,按alt+F11调出vb编辑接口

(3)点击ThisWorkBook,并粘贴如下代码(红色部分):


Private Sub hb()

    Dim hb As Object, kOne As Boolean, tabcolor As Long

    Set hb = Workbooks.Add

    Application.DisplayAlerts = False

    For i = hb.Sheets.Count To 2 Step -1

        hb.Sheets(i).Delete

    Next

     

    Dim FileName As String, FilePath As String

    Dim iFolder As Object, rwk As Object, Sh As Object

    Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")

    If iFolder Is Nothing Then Exit Sub

    FilePath = iFolder.Items.Item.Path

    FilePath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath & "\")

    FileName = Dir(FilePath & "*.xls*")

    Do Until Len(FileName) = 0

        If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then

            Set rwk = Workbooks.Open(FileName:=FilePath & FileName)

            tabcolor = Int(Rnd * 56) + 1

            With rwk

                For Each Sh In .Worksheets

                    Sh.Copy After:=hb.Sheets(hb.Sheets.Count)

                    hb.Sheets(hb.Sheets.Count).Name = FileName & "-" & Sh.Name

                    hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor

                    If Not kOne Then hb.Sheets(1).Delete: kOne = True

                Next

                .Close True

             End With

        End If

        Set rwk = Nothing

        FileName = Dir

    Loop

    Application.DisplayAlerts = True

End Sub


(4)按F5运行,会弹出让你选择要合并的文件夹的窗口,选择文件夹即可

2、将多个excel文件合并在一个excel文件的一个sheet中

操作步骤一样,代码如下(红色部分):


sub 合并当前目录下所有工作簿的全部工作表() 

dim mypath, myname, awbname 

dim wb as workbook, wbn as string 

dim g as long 

dim num as long 

dim box as string 

application.screenupdating = false 

mypath = activeworkbook.path 

myname = dir(mypath & "\" & "*.xls") 

awbname = activeworkbook.name 

num = 0 

do while myname <> "" 

if myname <> awbname then 

set wb = workbooks.open(mypath & "\" & myname) 

num = num + 1 

with workbooks(1).activesheet 

.cells(.range("a65536").end(xlup).row + 2, 1) = left(myname, len(myname) - 4) 

for g = 1 to sheets.count 

wb.sheets(g).usedrange.copy .cells(.range("a65536").end(xlup).row + 1, 1) 

next 

wbn = wbn & chr(13) & wb.name 

wb.close false 

end with 

end if 

myname = dir 

loop 

range("a1").select 

application.screenupdating = true 

msgbox "共合并了" & num & "个工作薄下的全部工作表。如下:" & chr(13) & wbn, vbinformation, "提示" 

end sub



(2)按F5运行代码,选择要合并的文件,效果如下




Copyright © 2014-2022 zzliaoyuan.com All Rights Reserved.
郑州燎原计算机技术有限公司 豫ICP备15004940号