从外部源复制多行

时间:2016-07-14 18:53:49

标签: vba excel-vba excel

我有一个问题,我想将数据从一个工作簿复制到另一个工作簿。我试图复制的工作簿有两张,我将数据从两个数据中拉出来。问题是当我尝试从扫描表中复制数组中的数据时(因为它更准确),它不会列出所有扫描的行。

感谢任何帮助。

代码/图像

图片:

This is the data to grab

This is the results

代码:

' *报告工作从这里开始。

lngLineNum = 0

RecursiveDir colFiles, strPath, "*_*_*_*.xlsm", True

For Each varFile In colFiles
    Set wbkReportBook = Workbooks.Open(varFile)
    Set wstSUData = wbkReportBook.Sheets("SUData")
    Set wstScanSheet = wbkReportBook.Sheets("Scan Sheet")

    lngReportRow = 8

    Do While wstSUData.Cells(lngReportRow, 1) <> ""
        lngLineNum = lngLineNum + 1

&#39; *保留SUData的报告数据。

            With wstSUData
                strPtNum = .Cells(lngReportRow, 1)
                strPartNo = .Cells(lngReportRow, 2)
                strSU = .Cells(lngReportRow, 3)
                strQuantity = .Cells(lngReportRow, 4)
                strShipper = .Cells(lngReportRow, 5)
                strHtsCode = .Cells(lngReportRow, 6)
                strCOO = .Cells(lngReportRow, 7)
                strItemWeight = .Cells(lngReportRow, 8)
                strPrice = .Cells(lngReportRow, 9)
                strMOD = .Cells(lngReportRow, 10)
                strDealer = .Cells(lngReportRow, 11)
                strDesc = .Cells(lngReportRow, 12)
                strPDC = .Cells(lngReportRow, 13)
                strScanQuantity = .Cells(lngReportRow, 14)
                strRemain = .Cells(lngReportRow, 15)
                strStatus = .Cells(lngReportRow, 16)
                strAuditor = .Cells(lngReportRow, 17)
                strWeightUpdate = .Cells(lngReportRow, 18)
                strCOO_Num = .Cells(lngReportRow, 19)
                strSpecial = .Cells(lngReportRow, 20)
                strScale = .Cells(lngReportRow, 21)
                datDate = dateScrub(.Cells(5, 1))
            End With

            dblDate = CDbl(datDate)

            ReDim Preserve strReportArray(26, lngLineNum)
            strReportArray(0, lngLineNum) = varFile
            strReportArray(1, lngLineNum) = strPtNum
            strReportArray(2, lngLineNum) = strPartNo
            strReportArray(3, lngLineNum) = strSU
            strReportArray(4, lngLineNum) = strExpectQuantity
            strReportArray(5, lngLineNum) = strShipper
            strReportArray(6, lngLineNum) = strHtsCode
            strReportArray(7, lngLineNum) = strCOO
            strReportArray(8, lngLineNum) = strItemWeight
            strReportArray(9, lngLineNum) = strPrice
            strReportArray(10, lngLineNum) = strMOD
            strReportArray(11, lngLineNum) = strDealer
            strReportArray(12, lngLineNum) = strPDC
            strReportArray(13, lngLineNum) = strWTF
            strReportArray(14, lngLineNum) = strScanQuantity
            strReportArray(15, lngLineNum) = strRemain
            strReportArray(16, lngLineNum) = strStatus
            strReportArray(17, lngLineNum) = strAuditor
            strReportArray(18, lngLineNum) = strWeightUpdate
            strReportArray(19, lngLineNum) = strCOO_Num
            strReportArray(20, lngLineNum) = strSpecial
            strReportArray(21, lngLineNum) = strScale
            strReportArray(22, lngLineNum) = dblDate
            strReportArray(23, lngLineNum) = 0
            strReportArray(24, lngLineNum) = CreateObject("Scripting.FileSystemObject").GetFile(varFile).DateLastModified
            strReportArray(25, lngLineNum) = ""
            strReportArray(26, lngLineNum) = ""

        lngReportRow = lngReportRow + 1

    Loop

&#39; *保留扫描表中的报告数据。

    lngReportRow = 9
    lngLineNum = 0

    Do While wstScanSheet.Cells(lngReportRow, 1) <> ""
            lngLineNum = lngLineNum + 1


            With wstScanSheet
                strPickTicket = .Cells(lngReportRow, 1)
                strScanCOO = .Cells(lngReportRow, 2)
                strPartNo = .Cells(lngReportRow, 3)
                strScanQuantity = .Cells(lngReportRow, 4)
                strExpectQuantity = .Cells(lngReportRow, 5)
                strRemain = .Cells(lngReportRow, 6)
                strSU = .Cells(lngReportRow, 7)
                strStatus = .Cells(lngReportRow, 8)
                strSystemCOO = .Cells(lngReportRow, 9)
                strCOOStatus = .Cells(lngReportRow, 10)
                strItemWeight = .Cells(lngReportRow, 11)
                strSpecial = .Cells(lngReportRow, 12)
                strScale = .Cells(lngReportRow, 13)
                strAuditor = .Cells(1, 3)
            End With

            ReDim Preserve strReportArray(26, lngLineNum)
            strReportArray(0, lngLineNum) = varFile
            strReportArray(1, lngLineNum) = strPtNum
            strReportArray(2, lngLineNum) = strPartNo
            strReportArray(3, lngLineNum) = strSU
            strReportArray(4, lngLineNum) = strExpectQuantity
            'strReportArray(5, lngLineNum) = ""
            'strReportArray(6, lngLineNum) = ""
            'strReportArray(7, lngLineNum) = ""
            strReportArray(8, lngLineNum) = strItemWeight
            'strReportArray(9, lngLineNum) = ""
            'strReportArray(10, lngLineNum) = ""
            'strReportArray(11, lngLineNum) = ""
            'strReportArray(12, lngLineNum) = ""
            'strReportArray(13, lngLineNum) = ""
            strReportArray(14, lngLineNum) = strScanQuantity
            strReportArray(15, lngLineNum) = strRemain
            strReportArray(16, lngLineNum) = strStatus
            strReportArray(17, lngLineNum) = strAuditor
            'strReportArray(18, lngLineNum) = ""
            'strReportArray(19, lngLineNum) = ""
            strReportArray(20, lngLineNum) = strSpecial
            strReportArray(21, lngLineNum) = strScale
            strReportArray(22, lngLineNum) = dblDate
            strReportArray(23, lngLineNum) = 0
            strReportArray(24, lngLineNum) = CreateObject("Scripting.FileSystemObject").GetFile(varFile).DateLastModified
            strReportArray(25, lngLineNum) = strSystemCOO
            strReportArray(26, lngLineNum) = strCOOStatus
        ''End If

        lngReportRow = lngReportRow + 1

    Loop

    wbkReportBook.Close SaveChanges:=False

&#39; *报告工作在此结束。

Next varFile

&#39; *粘贴数据。

lngBaseRow = 2

Do While wstSuScan.Cells(lngBaseRow, 1) <> ""
    lngBaseRow = lngBaseRow + 1
Loop


For lngLineNum = 1 To UBound(strReportArray, 2)

    varWeek = strReportArray(22, lngLineNum)
    Do Until Weekday(varWeek, vbSunday) = 2
        varWeek = varWeek - 1
    Loop

    With wstSuScan
        .Cells(lngBaseRow, 1) = varWeek
        .Cells(lngBaseRow, 2) = strReportArray(22, lngLineNum) 'date
        .Cells(lngBaseRow, 3) = strReportArray(12, lngLineNum) 'depot
        .Cells(lngBaseRow, 4) = strReportArray(11, lngLineNum) 'dealer
        .Cells(lngBaseRow, 5) = strReportArray(10, lngLineNum) 'mod
        .Cells(lngBaseRow, 6) = strReportArray(5, lngLineNum) 'shipper
        .Cells(lngBaseRow, 7) = strReportArray(1, lngLineNum) 'ticket
        .Cells(lngBaseRow, 8) = strReportArray(2, lngLineNum) 'part
        .Cells(lngBaseRow, 9) = strReportArray(14, lngLineNum) 'scanned
        .Cells(lngBaseRow, 10) = strReportArray(4, lngLineNum) 'expected
        .Cells(lngBaseRow, 11) = strReportArray(15, lngLineNum) 'remain
        .Cells(lngBaseRow, 12) = strReportArray(3, lngLineNum) 'su
        .Cells(lngBaseRow, 13) = strReportArray(16, lngLineNum) 'status
        .Cells(lngBaseRow, 14) = strReportArray(17, lngLineNum) 'auditor
        .Cells(lngBaseRow, 15) = strReportArray(18, lngLineNum) 'weight update
        .Cells(lngBaseRow, 16) = strReportArray(7, lngLineNum) 'coo
        .Cells(lngBaseRow, 17) = strReportArray(20, lngLineNum) 'special
        .Cells(lngBaseRow, 18) = strReportArray(21, lngLineNum) 'scale
        .Cells(lngBaseRow, 19) = strReportArray(25, lngLineNum)
        .Cells(lngBaseRow, 20) = strReportArray(26, lngLineNum)
        .Cells(lngBaseRow, 21) = strReportArray(8, lngLineNum)
        .Cells(lngBaseRow, 22) = strReportArray(20, lngLineNum)
        .Cells(lngBaseRow, 23) = strReportArray(21, lngLineNum)

    End With

    lngBaseRow = lngBaseRow + 1

Next lngLineNum

1 个答案:

答案 0 :(得分:0)

如果我已正确读取您的代码,则可能(可能)发生问题,因为lngLineNum在代码开始时(访问任何文件之前)初始化,并且在处理扫描数据表时开始。每当您阅读扫描数据表时,您也会重新调整StringReportArray。

假设您的第一个文件有x行数据,第二个文件有y行,第三个文件有z行。

您将从文件1的SUData表填充StringReportArray的第1位到第x位。

然后重置StringReportArray,并从文件1的扫描数据表中填充StringReportArray位置1到x的一些字段。

然后开始处理第二个文件,并从文件2的SUData填充x + 1到x + y的位置。

然后重置StringReportArray并从文件2的扫描数据填充位置1到y(不是x + 1到x + y)。

然后开始处理第三个文件,并从文件3的SUData中填充y + 1到y + z(而不是x + y + 1到x + y + z)的位置。

然后重置StringReportArray并从文件3的扫描数据填充位置1到z(不是x + y + 1到x + y + z)。

以上都假定您的SUData和扫描数据表中的行数相同,SUData中的每一行都对应于扫描数据中的等效行。 (例如,SUData第8行与扫描数据第9行有关,SUData第9行与扫描数据第10行有关,... SUData第200行与扫描数据第201行有关,...)如果您不这样做,那么你的整个方法都存在缺陷,而不仅仅是代码的一部分。

此外,当您处理扫描数据的每一行时,您将从SUData处理的最后一行中获取的strPtNum值存储到StringReportArray中。

最好我可以看出输出的第一行将包含来自您处理的第一个文件的第一行SUData中的值,其中一些值来自您处理的最后一个文件的第一行扫描数据。输出中的其他行将仅包含从您处理的上一个文件的“扫描数据”中的其他行获取的信息。但是&#34; Ticket&#34; column将在输出的所有行中包含相同的值,从最后一个处理文件的SUData的最后一行获取。

输出中的总行数将是上次处理文件的“扫描数据”表中的行数。

(并且,如果您的RecursiveDir函数只拾取了一个文件,&#34;第一个文件&#34;将与&#34;最后一个文件&#34;相同的文件;因为它是唯一的文件。 )

如果这描述了你得到的输出,你的问题几乎肯定是由于第一段中描述的问题。