尝试将分解报告中的数据合并回主数据库(使用的索引)

时间:2016-12-17 03:12:22

标签: excel-vba vba excel

经常听众,但第一次打电话,所以请放轻松。通过这里的大量研究,YouTube,谷歌等自学VBA和反复试验。

为了隐私原因,编写了一个脚本,将每个人的大型报告分解为单个较小的报告,除了他们自己的行之外,报告中没有其他数据(例如,他们的行可能在第5,27,88,257行)另一个文件是7,558,620,但所有其他行都是空白的)。他们的报告被过滤保存,因此他们的行连续显示。现在他们每个人都完成了它并将它发回给我,我将所有这些报告保存在一个特定的目录(“blah”)中并编写了另一个脚本,试图将其合并回一个主文件。

当我只提供几个文件来运行时似乎工作得很好但是在经历了100之后,它开始从其他目录中的其他文件中提取数据并将它们划分到设置的目标单元格中​​(Q, R,S,T,V)。在打开目标(主)文件的情况下多次运行,甚至关闭所有其他工作簿以确保。这个宏在我的personal.xlsb下,我保存了一些其他的宏,但我只运行这个。

我知道我的I=2 to 1000并不是最有效的方法,但它似乎足够快,最多只有几百个报告我需要在任何给定时间使用它来组合。 / p>

Sub MergeBackReport()
Dim wbkS As Workbook 'used ___S as "S"ource
Dim wbkD As Workbook 'and ___D as "D"estination to make it easier for me to follow
Dim wshD As Worksheet
Dim strFile As String
Dim Filename As String
Dim i, c As Long
c = 0
Application.ScreenUpdating = False
Set wshD = ActiveSheet 'my current open Master report that I'm meshing the data back into just for the select cells below
Path = "\\blah\" 'where I'm reading the received worksheets from
Filename = Dir(Path & "*.xlsx")
    Do While Filename <> "" 'runs while there's files in the blah directory to run through
        'MsgBox (Filename) 'just a check to see which file it opened, seems fine
        Set wbkS = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
        On Error Resume Next
        Set wshS = wbkS.Worksheets(1)
        For i = 2 To 1000
            If Not IsEmpty(Range("A" & i).Value) Then 'looking for the 1st non empty row with data, the 1st column being the index of where I need it to paste.
                'MsgBox (i) "just checking the above, seems fine
                wshD.Range("Q" & i).Value = wshS.Range("Q" & i).Value '1st cell I need to populate
                wshD.Range("R" & i).Value = wshS.Range("R" & i).Value '2nd cell I need to populate
                wshD.Range("S" & i).Value = wshS.Range("S" & i).Value '3rd cell I need to populate
                wshD.Range("T" & i).Value = wshS.Range("T" & i).Value '4th cell I need to populate
                wshD.Range("V" & i).Value = wshS.Range("V" & i).Value '5th cell I need to populate
            End If
        Next i
        wbkS.Close SaveChanges:=False
        Filename = Dir()
        c = c + 1
    Loop
    MsgBox "Yay! I just combined " & c & " reports for you!" 
End Sub

是否与我如何定义目标工作表有关?它正是在正确的位置粘贴正确的信息,只是从我正在运行的目录中的几个级别完全不同的源文件。令人困惑的是它似乎完全在随机时间并且仅在我加载后才开始发生它可以运行多个文件。它似乎在某些时候从其他地方的源文件中读取,然后用空白覆盖了大量数据。

在星期一之前有很多压力使这个工作(并且我认为直到我发现它不是这样)所以任何帮助都会受到赞赏。这让我疯了!请记住,我是一个相对的菜鸟!

0 个答案:

没有答案