EXCEL工具箱(2009-8-11更新)

prober

各种EXCEL批量操作工具箱，包括多种汇总合并等功能。
需Excel2003支持，界面简单试试容易用。
比较偷懒，使用前期绑定Excel插件，并不支持Excel2000和2007版本，如需求较大再更改。
有些网友要原代码，核心代码在3楼，用VB6编写的，和VBA有些不同，但原理都一样。
觉得好用的网友请顶一下，别让它沉了，以便让更多的人看得到。
使用出任何BUG请详细说明，以便改正；任何意见或建议欢迎交流。

AutoExcel.rar (20.88 KB, 下载次数: 5057)

2009-8-11 08:52 上传

点击文件名下载附件

没有说明.rar (86 Bytes, 下载次数: 3822)

2009-8-11 08:52 上传

点击文件名下载附件

[ 本帖最后由 prober 于 2009-8-11 08:52 编辑 ]

xibeiakang

楼主这个东东是用什么做的啊。

prober

Private Sub ExcelCount(SheetType)
    If DirPart.Path = DirTotal.Path Then
        MsgBox "为提高处理速度，请不要把总表文件和分表文件放于同一文件夹下！", _
            vbOKOnly + vbExclamation, "警告"
    ElseIf FileTotal.FileName = "" Then
        MsgBox "请先在总表文件列表框内选择总表文件！", vbOKOnly + vbCritical, "错误"
    Else
    Dim xlsApp As Object
    Dim xlsBookTotal As Object
    Dim xlsBookPart As Object
    Dim xlsSheetTotal As Object
    Dim xlsSheetPart As Object
    Dim i As Integer
    Dim j As Integer
    Dim intFileCount As Integer
    Dim intHead As Integer
    Dim intEnd As Integer
    Dim intLastRow As Long
    Dim intLastRowPart As Long
    Dim timeStart As Date
   
    On Error GoTo ErrHandle
    lblInfo.ForeColor = vbBlue
    lblInfo.Caption = "正在汇总…"
    timeStart = Now()
   
    Set xlsApp = CreateObject("Excel.Application")
    Set xlsBookTotal = xlsApp.Workbooks.Open(DirTotal.Path & "\" & FileTotal.FileName)
    Set xlsSheetTotal = xlsBookTotal.Worksheets(1)
   
    intFileCount = FilePart.ListCount
    intHead = txtHead.Text + 1
    intEnd = txtEnd.Text
   
    If VarType(SheetType) = vbBoolean Then
        For i = 0 To intFileCount - 1
            Set xlsBookPart = xlsApp.Workbooks.Open(DirPart.Path & "\" & FilePart.List(i))
            For Each xlsSheetPart In xlsBookPart.Worksheets
                intLastRow = xlsSheetTotal.Range("A65536").End(xlUp).Row + 1
                With xlsSheetPart
                    intLastRowPart = .Range("A65536").End(xlUp).Row
                    .Rows(intHead & ":" & intLastRowPart - intEnd).Copy xlsSheetTotal.Range("A" & intLastRow)
                End With
            Next
            xlsBookPart.Close
            lblProgressBar.Width = (i + 1) / intFileCount * 5000
            lblInfo.Caption = (i + 1) & "/" & intFileCount
        Next
    Else
        For i = 0 To intFileCount - 1
            Set xlsBookPart = xlsApp.Workbooks.Open(DirPart.Path & "\" & FilePart.List(i))
            intLastRow = xlsSheetTotal.Range("A65536").End(xlUp).Row + 1
            With xlsBookPart.Worksheets(SheetType)
                intLastRowPart = .Range("A65536").End(xlUp).Row
                .Rows(intHead & ":" & intLastRowPart - intEnd).Copy xlsSheetTotal.Range("A" & intLastRow)
            End With
            xlsBookPart.Close
            lblProgressBar.Width = (i + 1) / intFileCount * 5000
            lblInfo.Caption = (i + 1) & "/" & intFileCount
        Next
    End If
   
    If cekDelBlankRow.Value = Checked Then
        xlsSheetTotal.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End If
   
    xlsBookTotal.Save
    xlsBookTotal.Close
    lblInfo.Caption = "汇总完成！"
   
    MsgBox "汇总完成！" & vbLf & "文件数量：" & intFileCount & vbLf & "消耗时间：" & _
        Format(Now() - timeStart, "hh:mm:ss"), vbOKOnly + vbInformation, "汇总完成"
ErrHandle:
    If lblInfo.Caption <> "汇总完成！" Then
        lblInfo.ForeColor = vbRed
        lblInfo.Caption = "操作错误！"
    End If
    xlsApp.Quit
    Set xlsSheetTotal = Nothing
    Set xlsSheetPart = Nothing
    Set xlsBookTotal = Nothing
    Set xlsBookPart = Nothing
    Set xlsApp = Nothing
    End If
End Sub

[ 本帖最后由 prober 于 2009-2-12 08:01 编辑 ]

shzzj99

QUOTE:

以下是引用prober在2008-10-8 15:02:00的发言：

任何意见或建议欢迎交流

好东西，谢谢

hgzmal

请问楼主：你的EXE文件是怎么做出来的？要借助软件吗？我听人家说好象是打包什么的，是吗？就象在ACCESS里面做个小窗体文件一样，我想让它单独运行。怎么做呀？请赐教！谢谢！

prober

我是用VB6作的 需要Excel2003支持

未流云

强，楼主偑服！[em17]

szqhb

强，向你学习！！希望以后能得到你的帮助。

habf2008

谢谢分享

prober

没有人在使用中提点改进的意见吗?

我是在实际工作中需要才作的这个,功能不多,而且有片面性.

我想作个比较通用的,希望有看过的给点意见建议.谢谢!

[此贴子已经被作者于2008-10-10 15:44:28编辑过]