VB6实现Excel多工作簿数据合并

Posted ryueifu-vba

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了VB6实现Excel多工作簿数据合并相关的知识,希望对你有一定的参考价值。

以前的同事,工作需要,让我帮忙完成多个工作簿的汇总。

我就用最熟悉的VB6写了一个Form应用程序,这是因为我不知道她目前的系统和Office情况,如果太高大上了,她不会部署安装。索性就简单粗暴地来个桌面App。

App的操作效果:

技术图片

 

程序源代码:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private f As Variant
Private i As Integer, j As Integer
Private ExcelApp As Excel.Application
Private wbk As Excel.Workbook, wbk2 As Excel.Workbook
Private wst As Excel.Worksheet, wst2 As Excel.Worksheet
Private rg As Excel.Range, rg2 As Excel.Range
Private arr() As Variant
Private Sub Command1_Click()
    On Error GoTo Err1
    If Me.List1.ListCount = 0 Or Me.Text1.Text = "" Or Me.Text2.Text = "" Then
        MsgBox "不满足合并条件,请确认各项,然后重试。", vbExclamation
        Exit Sub
    End If
    Set ExcelApp = CreateObject("Excel.Application")
    With ExcelApp
        .Visible = True
        .WindowState = xlMaximized
        Set wbk2 = .Workbooks.Add
        Set wst2 = wbk2.Worksheets(1)
        For i = 0 To Me.List1.ListCount - 1
            Me.List1.ListIndex = i
            f = Me.List1.List(i)
            If Dir(f) <> "" Then
                Set wbk = .Workbooks.Open(FileName:=f, UpdateLinks:=False)
                Set wst = wbk.Worksheets(Me.Text1.Text)
                Set rg = wst.Range(Me.Text2.Text)
                ReDim arr(1 To rg.Cells.Count)
                j = 0
                For Each rg2 In rg
                    j = j + 1
                    arr(j) = rg2.Value
                Next rg2
                wst2.Cells(i + 2, "A").Resize(, UBound(arr)).Value = arr
                wbk.Close False
            End If
        Next i
        wst2.UsedRange.EntireColumn.AutoFit
    End With
    Exit Sub
Err1:
    MsgBox Err.Description, vbCritical
End Sub

如果要下载工具,请加QQ群:61840693,去群文件下载。

以上是关于VB6实现Excel多工作簿数据合并的主要内容,如果未能解决你的问题,请参考以下文章

Power Query 同一文件夹多工作簿合并

excel里面我想 用VBA实现调用另一个工作簿中的数据怎么解决

用VBA代码打开其他excel工作簿(有打开密码的)???

不同工作簿怎么合并 excel合并表格数据

Excel合并多个工作簿和拆分多个工作簿

多个Excel工作簿怎么合并成一个新的工作簿