[已解决]如何提取汇总同一文件夹下不同工作薄相同单元格位置的数值

fwx391

各位老师


描述：

1、K文件夹下有多个不同名称的工作薄文件
2、K文件夹下所有的工作薄格式相同

结果：

提取K文件夹下所有工作薄中指定单元格的数值并汇总(需提取的单元格是 D3 J4 L9 F15 H15)


请各位老师帮忙提供那的方法，谢谢

最佳答案

月排行榜 / 总排行榜

爱疯

2015-7-14 22:09

Sub test()
    Dim p, f, A(1 To 1000, 1 To 6), i
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\k\"
    f = Dir(p & "*.xlsx")

    Do While f <> ""
        With Workbooks.Open(p & f)
            With .Sheets(1)
                i = i + 1
                A(i, 1) = .[d3]
                A(i, 2) = .[j4]
                A(i, 3) = .[h15]
                A(i, 4) = .[f15]
                A(i, 5) = .[l9]
            End With
            .Close 0
        End With
        f = Dir
    Loop

    If i Then
        [b3:f65536] = ""
        [b3].Resize(i, UBound(A, 2)) = A
    End If
End Sub
ABC2.rar (28.75 KB, 下载次数: 58)

2015-7-14 22:09 上传

点击文件名下载附件

跳转到最佳答案楼层

fwx391

各位老师，附件上传错了

fwx391

各位好，
附件怎么传不了啊？

爱疯

还是不能上传附件吗？提示什么

fwx391

各位补传正确的附件上来

fwx391

爱疯 发表于 2015-7-14 16:05
还是不能上传附件吗？提示什么

可以了，是浏览器的兼容性设置问题，谢谢版主

天津吖頭

上传的此数据源为整人的节奏。估计工作不是这么做的吧？

fwx391

怎么会是整人的呢？工作中也是这样在做的，因为每个城区一张相同格式的表，最后要根据这些工作薄汇总指定单元格的数值

爱疯

Sub test()
    Dim p, f, A(1 To 1000, 1 To 6), i
    Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\k\"
    f = Dir(p & "*.xlsx")

    Do While f <> ""
        With Workbooks.Open(p & f)
            With .Sheets(1)
                i = i + 1
                A(i, 1) = .[d3]
                A(i, 2) = .[j4]
                A(i, 3) = .[h15]
                A(i, 4) = .[f15]
                A(i, 5) = .[l9]
            End With
            .Close 0
        End With
        f = Dir
    Loop

    If i Then
        [b3:f65536] = ""
        [b3].Resize(i, UBound(A, 2)) = A
    End If
End Sub
ABC2.rar (28.75 KB, 下载次数: 58)

2015-7-14 22:09 上传

点击文件名下载附件

wswangt

同一文件夹下有若干工作簿，要求提取工作簿名称，并根据工作簿名称提取两个指定工作表相同单元格的数据