循环Scrap数组时Excel输出重复最后一组数据的求助

编写VBA代码时遇到异常：第一组生产线信息数组读取并输出至Excel正常，遍历记录后读取Scrap表匹配工位转换信息统计报废数据，但生产线记录循环切换加载Scrap数组时，所有记录都被填充了最后一组Scrap数组的数据，而非对应记录的报废数据。怀疑是变量初始化或逻辑遗漏问题，源代码如下：

Public Function myScrapData() 

Dim myStation, myPart, myPartName, mySQL2, mySQL3 As String 
Dim myQTY, myDiagArray As Integer 
Dim myStart, myEnd As Variant 
Dim i As Long, s As Long 
Dim X As Long, Y As Long 
Dim ws As Worksheet 
Dim rowOffset As Long ' Variable to track the row offset in the worksheet 
Dim db2, db3 As DAO.Database 'db2 set for scrap table lookup 
Dim rs2, rs3 As DAO.Recordset 'rs2 set for scrap table lookup 


myStart = Me.txt_FromDate 
myEnd = Me.txt_ToDate 

mySQL = "SELECT Diagnostic_Log_Table.Identification_number, Diagnostic_Log_Table.Assembly_Line, Diagnostic_Log_Table.Station_Number, Diagnostic_Log_Table.Disposition, Diagnostic_Log_Table.Date_Started, Int([Date_Started]) AS EntryDate, Diagnostic_Log_Table.Pallet_Number, Station_Lookup.Station_Number_Lookup" _ 

    & " FROM Station_Lookup INNER JOIN Diagnostic_Log_Table ON Station_Lookup.Station_Number_Converted = Diagnostic_Log_Table.Station_Number" _ 

    & " WHERE (((Diagnostic_Log_Table.Assembly_Line)<>'Hybrid') AND ((Diagnostic_Log_Table.Disposition)='Scrap') AND ((Int([Date_Started])) Between #" & myStart & "# And #" & myEnd & "#));" 

'Debug.Print (mySQL) 
'This section will go through the diag log table and get the root records 
Set db = CurrentDb 
Set rs = db.OpenRecordset(mySQL) 
    With rs 
        rs.MoveLast 
        i = rs.RecordCount 
        Debug.Print (i) 
        rs.MoveFirst 
        ReDim myID(1 To i), myLine(1 To i), myStation(1 To i), myDisposition(1 To i) As String 
        ReDim myStartedDate(1 To i) As Date 
        ReDim myStationLUConverted(1 To i) As String '-------------------moved 

        For X = 1 To i 
            myID(X) = rs!Identification_number
            myLine(X) = rs!Assembly_Line 
            myStation(X) = rs!Station_Number
            myDisposition(X) = rs!Disposition
            myStartedDate(X) = rs!Date_Started

 'This section will be grabbing the necessary scrap items from the scrap lookup table 
            mySQL2 = "SELECT Station_Lookup.* FROM Station_Lookup WHERE (Station_Lookup.Station_Number_Converted)='" & myStation(X) & "';" 
            Debug.Print (mySQL2) 
            Set db2 = CurrentDb 
            Set rs2 = db.OpenRecordset(mySQL2) 
            With rs2 
               myStationLUConverted(X) = rs2!Station_Number_Lookup 
            End With 

            'This section will add the scrap parts in the next set of arrays. 
             mySQL3 = "SELECT Scrap_Table.* FROM Scrap_Table WHERE (Scrap_Table.Line)='" & myLine(X) & "' AND (Scrap_Table.Station_Converted)<=" & CDec(myStationLUConverted(X)) & ";" 
             Debug.Print (mySQL3) 
             Set db3 = CurrentDb 
             Set rs3 = db.OpenRecordset(mySQL3) 
             s = 0 
             With rs3 
                 rs3.MoveLast 
                 s = rs3.RecordCount 
                 rs3.MoveFirst 

                 ReDim myScrapLine(1 To s), myScrapStation(1 To s), myScrapPartName(1 To s), myScrapPartNumber(1 To s) As String 

                 ReDim myScrapQTY(1 To s) As Integer 

                 myID2 = rs3!ID 

                 For Y = 1 To s 

                     '-----This sect 
                      myScrapLine(Y) = rs3!Line
                      myScrapStation(Y) = rs3!Station 
                      myScrapPartName(Y) = rs3!Part_Name 
                      myScrapPartNumber(Y) = rs3!Part_Number 
                      myScrapQTY(Y) = rs3!Part_Qty 

                      Debug.Print (myScrapLine(Y) & "|" & myScrapStation(Y) & "|" & myScrapPartName(Y) & "|" & myScrapPartNumber(Y) & "|" & myScrapQTY(Y)) 

                      rs3.MoveNext 
                  Next Y 
              End With 

        rs.MoveNext 

'            Debug.Print (myID(X) & "|" & myLine(X) & "|" & myStation(X) & "|" & myDisposition(X) & "|" & myStartedDate(X)) 

       Next X 

         
   End With 

Set db = Nothing 
Set rs = Nothing 
Set db2 = Nothing 
Set rs2 = Nothing 
Set db3 = Nothing 
Set rs3 = Nothing 

'This section will output results to an excel sheet. 
Dim xlApp As Object ' Excel.Application 

    Dim ThisWorkBook As Object ' Excel.Workbook 

     
    ' Create a new instance of Excel and open a new workbook 

    On Error Resume Next ' In case Excel is already open 

    Set xlApp = GetObject(, "Excel.Application") 

    On Error GoTo 0 

    If xlApp Is Nothing Then 

        Set xlApp = CreateObject("Excel.Application") 

    End If 

     
    Set ThisWorkBook = xlApp.Workbooks.Add 

    xlApp.Visible = True ' Show Excel window 

     
    ' Add a new worksheet 

    Set ws = ThisWorkBook.Sheets.Add 

    ws.Name = "ScrapData" ' Change the worksheet name to your desired name 

 
    ' Headers 

    ws.Cells(1, 1).Value = "ID"
    ws.Cells(1, 2).Value = "Assembly Line"
    ws.Cells(1, 3).Value = "Station Number" 
    ws.Cells(1, 4).Value = "Disposition" 
    ws.Cells(1, 5).Value = "Date Started" 
    ws.Cells(1, 6).Value = "Part Name" 
    ws.Cells(1, 7).Value = "Part Number" 
    ws.Cells(1, 8).Value = "Scrap Quantity" 
    ' Data 
    rowOffset = 2 ' Start writing data from row 2 
    columnOffset = 5 'Start writing data from column 5 

    Dim myRow As Integer 

    myRow = 0 

    For K = 1 To i 
        myRow = myRow + 1 
        ws.Cells(rowOffset + myRow, 1).Value = myID(K) 
        ws.Cells(rowOffset + myRow, 2).Value = myLine(K) 
        ws.Cells(rowOffset + myRow, 3).Value = myStation(K) 
        ws.Cells(rowOffset + myRow, 4).Value = myDisposition(K) 
        ws.Cells(rowOffset + myRow, 5).Value = myStartedDate(K) 
         
        'this is where the scrap data gets added 
        Z = 0 
        N = 1 

        For H = 1 To s             
            ws.Cells(rowOffset + myRow + Z, columnOffset + N).Value = myScrapPartName(H) 
            ws.Cells(rowOffset + myRow + Z, columnOffset + N + 1).Value = myScrapPartNumber(H) 
            ws.Cells(rowOffset + myRow + Z, columnOffset + N + 2).Value = myScrapQTY(H) 

            Z = Z + 1 
         Next H 

         myRow = myRow + Z 
   Next K 

 
    ' Autofit columns to fit the data 
    ws.Columns.AutoFit  

    ' Release Excel objects 
    Set ws = Nothing 
    Set ThisWorkBook = Nothing 
    Set xlApp = Nothing 

End Function 

问题根源 #

1. Scrap数据数组无分组存储：当前myScrapPartName等是一维数组，每次循环会覆盖之前的数据，最终仅保留最后一次循环的Scrap结果。
2. 输出时复用全局变量：输出循环中For H = 1 To s的s是最后一次循环的记录数，而非当前生产线对应的Scrap记录数。

修正方案 #

将Scrap数据改为分组存储，用二维数组（数组的数组）保存每条生产线的独立Scrap数据，同时记录每条生产线的Scrap记录数量，确保输出时匹配对应数据。

修正后的代码 #

Public Function myScrapData()

    Dim myStation, myPart, myPartName, mySQL, mySQL2, mySQL3 As String
    Dim myQTY, myDiagArray As Integer
    Dim myStart, myEnd As Variant
    Dim i As Long, s As Long
    Dim X As Long, Y As Long, K As Long, H As Long
    Dim ws As Worksheet
    Dim rowOffset As Long ' Variable to track the row offset in the worksheet
    Dim db, db2, db3 As DAO.Database
    Dim rs, rs2, rs3 As DAO.Recordset
    
    ' 声明分组存储Scrap数据的数组，以及记录每条生产线的Scrap数量
    Dim myScrapPartName() As Variant
    Dim myScrapPartNumber() As Variant
    Dim myScrapQTY() As Variant
    Dim scrapCount() As Long

    myStart = Me.txt_FromDate
    myEnd = Me.txt_ToDate

    mySQL = "SELECT Diagnostic_Log_Table.Identification_number, Diagnostic_Log_Table.Assembly_Line, Diagnostic_Log_Table.Station_Number, Diagnostic_Log_Table.Disposition, Diagnostic_Log_Table.Date_Started, Int([Date_Started]) AS EntryDate, Diagnostic_Log_Table.Pallet_Number, Station_Lookup.Station_Number_Lookup" _
        & " FROM Station_Lookup INNER JOIN Diagnostic_Log_Table ON Station_Lookup.Station_Number_Converted = Diagnostic_Log_Table.Station_Number" _
        & " WHERE (((Diagnostic_Log_Table.Assembly_Line)<>'Hybrid') AND ((Diagnostic_Log_Table.Disposition)='Scrap') AND ((Int([Date_Started])) Between #" & myStart & "# And #" & myEnd & "#));"

    Set db = CurrentDb
    Set rs = db.OpenRecordset(mySQL)
    With rs
        rs.MoveLast
        i = rs.RecordCount
        Debug.Print (i)
        rs.MoveFirst
        ReDim myID(1 To i), myLine(1 To i), myStation(1 To i), myDisposition(1 To i) As String
        ReDim myStartedDate(1 To i) As Date
        ReDim myStationLUConverted(1 To i) As String
        ' 初始化分组存储数组
        ReDim myScrapPartName(1 To i) As Variant
        ReDim myScrapPartNumber(1 To i) As Variant
        ReDim myScrapQTY(1 To i) As Variant
        ReDim scrapCount(1 To i) As Long

        For X = 1 To i
            myID(X) = rs!Identification_number
            myLine(X) = rs!Assembly_Line
            myStation(X) = rs!Station_Number
            myDisposition(X) = rs!Disposition
            myStartedDate(X) = rs!Date_Started

            ' 获取工位转换信息
            mySQL2 = "SELECT Station_Lookup.* FROM Station_Lookup WHERE (Station_Lookup.Station_Number_Converted)='" & myStation(X) & "';"
            Debug.Print (mySQL2)
            Set db2 = CurrentDb
            Set rs2 = db.OpenRecordset(mySQL2)
            With rs2
               myStationLUConverted(X) = rs2!Station_Number_Lookup
            End With
            rs2.Close
            Set rs2 = Nothing
            Set db2 = Nothing

            ' 获取当前生产线的Scrap数据
             mySQL3 = "SELECT Scrap_Table.* FROM Scrap_Table WHERE (Scrap_Table.Line)='" & myLine(X) & "' AND (Scrap_Table.Station_Converted)<=" & CDec(myStationLUConverted(X)) & ";"
             Debug.Print (mySQL3)
             Set db3 = CurrentDb
             Set rs3 = db.OpenRecordset(mySQL3)
             s = 0
             With rs3
                 If Not (.BOF And .EOF) Then
                     rs3.MoveLast
                     s = rs3.RecordCount
                     rs3.MoveFirst
                     ' 临时存储当前生产线的Scrap数据
                     ReDim tempPartName(1 To s) As String
                     ReDim tempPartNumber(1 To s) As String
                     ReDim tempQTY(1 To s) As Integer

                     For Y = 1 To s
                          tempPartName(Y) = rs3!Part_Name
                          tempPartNumber(Y) = rs3!Part_Number
                          tempQTY(Y) = rs3!Part_Qty

                          Debug.Print (myLine(X) & "|" & rs3!Station & "|" & tempPartName(Y) & "|" & tempPartNumber(Y) & "|" & tempQTY(Y))

                          rs3.MoveNext
                      Next Y
                      ' 将临时数组赋值给分组存储数组
                      myScrapPartName(X) = tempPartName
                      myScrapPartNumber(X) = tempPartNumber
                      myScrapQTY(X) = tempQTY
                      scrapCount(X) = s
                 Else
                     ' 无Scrap数据时记录数量为0
                     scrapCount(X) = 0
                 End If
             End With
             rs3.Close
             Set rs3 = Nothing
             Set db3 = Nothing

        rs.MoveNext
       Next X
    End With
    rs.Close
    Set rs = Nothing
    Set db = Nothing

' 输出到Excel
Dim xlApp As Object
Dim ThisWorkBook As Object

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0

    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
    End If

    Set ThisWorkBook = xlApp.Workbooks.Add
    xlApp.Visible = True

    Set ws = ThisWorkBook.Sheets.Add
    ws.Name = "ScrapData"

    ' 写入表头
    ws.Cells(1, 1).Value = "ID"
    ws.Cells(1, 2).Value = "Assembly Line"
    ws.Cells(1, 3).Value = "Station Number"
    ws.Cells(1, 4).Value = "Disposition"
    ws.Cells(1, 5).Value = "Date Started"
    ws.Cells(1, 6).Value = "Part Name"
    ws.Cells(1, 7).Value = "Part Number"
    ws.Cells(1, 8).Value = "Scrap Quantity"

    rowOffset = 2
    columnOffset = 5
    Dim myRow As Integer
    myRow = 0

    For K = 1 To i
        myRow = myRow + 1
        ws.Cells(rowOffset + myRow, 1).Value = myID(K)
        ws.Cells(rowOffset + myRow, 2).Value = myLine(K)
        ws.Cells(rowOffset + myRow, 3).Value = myStation(K)
        ws.Cells(rowOffset + myRow, 4).Value = myDisposition(K)
        ws.Cells(rowOffset + myRow, 5).Value = myStartedDate(K)

        Z = 0
        N = 1
        ' 使用当前生产线的Scrap记录数循环
        For H = 1 To scrapCount(K)
            ws.Cells(rowOffset + myRow + Z, columnOffset + N).Value = myScrapPartName(K)(H)
            ws.Cells(rowOffset + myRow + Z, columnOffset + N + 1).Value = myScrapPartNumber(K)(H)
            ws.Cells(rowOffset + myRow + Z, columnOffset + N + 2).Value = myScrapQTY(K)(H)

            Z = Z + 1
         Next H

         myRow = myRow + Z
   Next K

    ws.Columns.AutoFit

    Set ws = Nothing
    Set ThisWorkBook = Nothing
    Set xlApp = Nothing

End Function

关键修改点 #

1. 分组存储Scrap数据：新增myScrapPartName等Variant数组，每个元素存储对应生产线的Scrap数据子数组；用scrapCount数组记录每条生产线的Scrap记录数。
2. 循环中独立存储数据：每次读取Scrap数据时先存入临时数组，再赋值给分组数组的对应位置，避免数据被覆盖。
3. 输出匹配对应数据：输出时使用scrapCount(K)获取当前生产线的Scrap记录数，通过myScrapPartName(K)(H)访问对应数据。
4. 完善资源释放：每次循环后关闭Recordset和Database对象，避免资源泄漏。

内容的提问来源于stack exchange，提问作者JasonNinKy