[已解决]当前文件夹里面有0到150个以内的excel表，求各excel表中第二张表格中最大的数字的和

qjsu

当前文件夹里面有0到150个以内的excel表，求各excel表中第二张表格中最大的数字的和

最佳答案

月排行榜 / 总排行榜

cbg2008

2013-1-7 21:37

Sub AA()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fso As Object
Dim rLookIn$, rFilename$, rCount%, ArrStr(), Total#
    Set fso = CreateObject("Scripting.FileSystemObject")
    rLookIn = ThisWorkbook.Path    'fd.SelectedItems(1)
    rFilename = Dir$(rLookIn & "\" & "*.xl*")
    rCount = 0
    ReDim Preserve ArrStr(1, rCount)
    Do While rFilename <> vbNullString
        If rFilename <> ThisWorkbook.Name Then
            ArrStr(0, rCount) = rFilename
            With Workbooks.Open(rLookIn & "\" & rFilename)
                ArrStr(1, rCount) = WorksheetFunction.Max(.Sheets(2).UsedRange)
                Total = Total + ArrStr(1, rCount)
                .Close
            End With
            rCount = rCount + 1
            ReDim Preserve ArrStr(1, rCount)
        End If
        rFilename = Dir$()
    Loop
    ArrStr(0, rCount) = "总计"
    ArrStr(1, rCount) = Total
    ThisWorkbook.Sheets(1).Range("a1").Resize(UBound(ArrStr, 2) + 1, UBound(ArrStr) + 1) = WorksheetFunction.Transpose(ArrStr)
    Set fso = Nothing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub

跳转到最佳答案楼层

cbg2008

Sub AA()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fso As Object
Dim rLookIn$, rFilename$, rCount%, ArrStr(), Total#
    Set fso = CreateObject("Scripting.FileSystemObject")
    rLookIn = ThisWorkbook.Path    'fd.SelectedItems(1)
    rFilename = Dir$(rLookIn & "\" & "*.xl*")
    rCount = 0
    ReDim Preserve ArrStr(1, rCount)
    Do While rFilename <> vbNullString
        If rFilename <> ThisWorkbook.Name Then
            ArrStr(0, rCount) = rFilename
            With Workbooks.Open(rLookIn & "\" & rFilename)
                ArrStr(1, rCount) = WorksheetFunction.Max(.Sheets(2).UsedRange)
                Total = Total + ArrStr(1, rCount)
                .Close
            End With
            rCount = rCount + 1
            ReDim Preserve ArrStr(1, rCount)
        End If
        rFilename = Dir$()
    Loop
    ArrStr(0, rCount) = "总计"
    ArrStr(1, rCount) = Total
    ThisWorkbook.Sheets(1).Range("a1").Resize(UBound(ArrStr, 2) + 1, UBound(ArrStr) + 1) = WorksheetFunction.Transpose(ArrStr)
    Set fso = Nothing
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End Sub

qjsu

看不懂啊，厉害~~~~~~~~~~~

qjsu

cbg2008 发表于 2013-1-7 21:37
Sub AA()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

老师能给解释一下吗？最好在每句的最后加一个解释~~~

cbg2008

晚上吧，可能要比较晚

qjsu

cbg2008 发表于 2013-1-8 18:00
晚上吧，可能要比较晚

没关系，我等你哈~~~~~~~~~~~~~~~··

cbg2008

Sub AA()    '子程序 AA()
Application.ScreenUpdating = False    '关闭屏幕刷新(可以提高运行速度)
Application.DisplayAlerts = False    '关闭警告信息显示
Dim fso As Object    '定义变量 fso 为 对象
Dim rLookIn$, rFilename$, rCount%, ArrStr(), Total#    '定义变量 rLookIn$,rFilename$,rCount%,ArrStr(),Total#
Set fso = CreateObject("Scripting.FileSystemObject")    '设定 fso=<创建工程>("Scripting.FileSystemObject")
rLookIn = ThisWorkbook.Path    'rLookIn= 当前工作簿的路
rFilename = Dir$(rLookIn & "\" & "*.xl*")    'rFilename=Dir$(rLookIn & "\" & "*.xl*")
rCount = 0    'rCount=0
ReDim Preserve ArrStr(1, rCount)    '重定义变量预留的ArrStr(1,rCount)
Do While rFilename <> vbNullString    '执行循环操作 当 rFilename 不等于空
    If rFilename <> ThisWorkbook.Name Then    '如果 rFilename 不等于  当前工作簿的名称 则执行
        ArrStr(0, rCount) = rFilename    'ArrStr(0,rCount)=rFilename，你可以用F8单步执行，看本地窗口的变量
        With Workbooks.Open(rLookIn & "\" & rFilename)    'WITH 工作簿集合的Open(rLookIn & "\" & rFilename)
            ArrStr(1, rCount) = WorksheetFunction.Max(.Sheets(2).UsedRange)    'ArrStr(1,rCount)= 工作表公式的<最大值>(打开的工作簿的第2张工作表的已使用区域)
            Total = Total + ArrStr(1, rCount)    'Total=Total+ArrStr(1,rCount)
            .Close    '关闭工作簿
        End With    'With语句结束
        rCount = rCount + 1    'rCount=rCount+1
        ReDim Preserve ArrStr(1, rCount)    '重定义变量预留的ArrStr(1,rCount)
    End If    'If判断过程结束
    rFilename = Dir$()    'rFilename=Dir$()
Loop    '循环执行
ArrStr(0, rCount) = "总计"    'ArrStr(0,rCount)="总计"
ArrStr(1, rCount) = Total    'ArrStr(1,rCount)=Total
ThisWorkbook.Sheets(1).Range("a1").Resize(UBound(ArrStr, 2) + 1, UBound(ArrStr) + 1) = WorksheetFunction.Transpose(ArrStr)    '<当前工作簿>的<工作表>1 )的<单元格>区域("a1" )的<重调大小>(<数组上限>(ArrStr,2)+1,<数组上限>(ArrStr)+1)= 工作表公式的<区域转置>(ArrStr)
Set fso = Nothing    '设定fso=空值
Application.ScreenUpdating = True    '打开屏幕刷新
Application.DisplayAlerts = True    '打开警告信息显示
End Sub    '子程序结束

qjsu

cbg2008 发表于 2013-1-8 22:58
Sub AA()    '子程序 AA()
Application.ScreenUpdating = False    '关闭屏幕刷新(可以提高运行速度)
A ...

Dim rLookIn$, rFilename$, rCount%, ArrStr(), Total#
这里面的$、%、#都是什么含义呢？

cbg2008

VBA的数据类型声明字符
短整型：%
长整型：&
单精度浮点型：!
双精度浮点型：#
货币型：@
字符串数据类型：$

qjsu

cbg2008 发表于 2013-1-9 13:44
VBA的数据类型声明字符
短整型：%
长整型：&

就是 as long   、  as string等的简写对吗？