| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1350 人关注过本帖
标题:求助,代码错误400,什么原因? 引用多个文件夹固定单元格数据
只看楼主 加入收藏
successmyc
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2022-4-25
收藏
 问题点数:0 回复次数:0 
求助,代码错误400,什么原因? 引用多个文件夹固定单元格数据

请教,汇总多个文件夹固定单元格数据,引用高手的代码如下,提示错误400,请教各位高手帮帮忙。
Sub 汇总数据()
        Dim arr, brr, i&, m&, k%, bookName$, wb As Workbook
        k = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count
        ReDim brr(1 To k, 1 To 8)
        m = 1
        arr = Array("文件名称", "销售单号", "打印日期", "合约编号", "项目名称", "单位", "金额", "经办人")
        For i = 0 To UBound(arr)
            brr(m, i + 1) = arr(i)
        Next
        Application.ScreenUpdating = False
        Dim mPath As String: mPath = ThisWorkbook.Path & "\"
        Dim mFile As String: mFile = Dir(mPath & "*.xls")
        Do
                If mFile <> ThisWorkbook.Name Then
                        Set wb = GetObject(mPath & mFile)
                        With wb
                                arr = .Worksheets(1).Range("Al").CurrentRegion.Value
                                bookName = Split(.Name, ".")(0)
                                .Close False
                        End With
                        m = m + 1
                        brr(m, 1) = bookName
                        brr(m, 2) = mTrim(arr(2, 11))
                        brr(m, 3) = arr(3, 11)
                        brr(m, 4) = arr(4, 11)
                        brr(m, 5) = arr(2, 5)
                        brr(m, 6) = mTrim(arr(5, 3))
                        brr(m, 7) = arr(8, 9)
                        brr(m, 8) = arr(12, 10)
                End If
                mFile = Dir
        Loop While mFile <> Empty
        If m = 1 Then Exit Sub
        With ActiveSheet
        .Cells.Clear
        .Range("Al").Resize(m, 8).Value = brr
        With .UsedRange
                .Borders.LineStyle = 1
                .Rows.AutoFit
                .Columns.AutoFit
        End With
        .Columns("B:H").HorizontalAlignment = xlCenter
        .Range("A1:H1").Interior.Colorlndex = 6
        End With
        Application.ScreenUpdating = True
        MsgBox "OK"
End Sub
Public Function mTrim(mStr) As String
        mStr = Application.Clean(mStr)
        mStr = VBA.Replace(mStr, Chr(0), Empty)
        mStr = VBA.Replace(mStr, Chr(10), Empty)
        mStr = VBA.Replace(mStr, Chr(13), Empty)
        mStr = VBA.Replace(mStr, Chr(32), Empty)
        mStr = VBA.Replace(mStr, Chr(127), Empty)
        mStr = VBA.Replace(mStr, "", Empty)
        mStr = VBA.Replace(mStr, "", Empty)
        mTrim = mStr
        End Function
引用多个EXCEL表的固定单位格数据.zip (38.66 KB)
搜索更多相关主题的帖子: With 错误 VBA Replace End 
2022-04-25 11:21
快速回复:求助,代码错误400,什么原因? 引用多个文件夹固定单元格数据
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.016433 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved