[已解决]VBA代码运行错误修改

安全网

点击图示的取消就出现错误，求助高手帮忙看看要修改哪里的代码

最佳答案

月排行榜 / 总排行榜

爱疯

2016-5-12 15:15

Sub 读入()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, 0)
    If fld Is Nothing Then End
   
    fp = fld.Self.Path
    Set wb = Workbooks.Open(fp & "\" & "数据表.xls", Password:="313", WriteResPassword:="313")  '读入
    y = wb.Sheets("数据表").[Match(1, 0 / (A:A <> ""))]
    arr = wb.Sheets("数据表").Range("a1:iv" & y)
    Set dc = CreateObject("scripting.dictionary")
    wb.Close False
    For i = 2 To UBound(arr, 2)
        dc(arr(2, i)) = i
    Next
    Application.ScreenUpdating = True
End Sub


多条件分类汇总2.rar (58.98 KB, 下载次数: 10)

2016-5-12 15:13 上传

点击文件名下载附件




颜色部分是改过的地方，其它未检查。

跳转到最佳答案楼层

爱疯

Sub 读入()
    Application.ScreenUpdating = False
    Dim wb As Workbook
    Set fso = CreateObject("scripting.filesystemobject")
    Set fld = CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, 0)
    If fld Is Nothing Then End
   
    fp = fld.Self.Path
    Set wb = Workbooks.Open(fp & "\" & "数据表.xls", Password:="313", WriteResPassword:="313")  '读入
    y = wb.Sheets("数据表").[Match(1, 0 / (A:A <> ""))]
    arr = wb.Sheets("数据表").Range("a1:iv" & y)
    Set dc = CreateObject("scripting.dictionary")
    wb.Close False
    For i = 2 To UBound(arr, 2)
        dc(arr(2, i)) = i
    Next
    Application.ScreenUpdating = True
End Sub


多条件分类汇总2.rar (58.98 KB, 下载次数: 10)

2016-5-12 15:13 上传

点击文件名下载附件




颜色部分是改过的地方，其它未检查。