Question

我很难遍历标题行之间的数据行以提取信息，然后对标题行下方几列中的数据求和，直到到达下一个标题行。我绝不是VBA专家，我只是想自己解决这个问题，我已将代码简化为一些基本知识，试图使这一部分正常工作。我不确定是否要采取正确的方法，但是我将数据从“原始数据”工作表导入到数组（“ rdA”，当前工作正常）中，然后尝试将标头数据放入我需要进入一个临时数组（“ rdB”，用于第一行，然后给出“超出范围错误”），并将其下面的数据行中的信息放入另一个临时数组（“ rdC”）中，以便我可以尝试求和数据并将总和添加到第一个临时数组。

标题行始终以[StartIspn]开头，我需要从标题行（时间戳，用户ID和侧面）提取特定数据。然后，我需要对下面几行的数据求和，但只对E列中包含“ A13”的行求和。下面的示例图像显示了原始数据的样子。在此示例中，顶部灰色标题行仅用于定义标题之间的数据列。我的想法是，这需要在循环内部进行循环以收集和求和必要的数据，但是我目前正试图将数据放入临时数组中而陷入困境。我的最终目标是创建一个包含Wafer S / N（标题之间的行的列B），时间戳，用户ID，Wafer Side（均来自每个标题行）以及F列之和，H列之和的数组。，标题行之间第6列中所有包含“ A13”的行的I列的最小值和J列的最大值。

如果我至少可以得到一些有关我使用的方法是否错误的指南，以及在尝试向临时数组添加数据时如何克服超出范围的错误，我将不胜感激

这是我到目前为止所拥有的：

' Define that arrays start with index 1 instead of 0
Option Base 1

' Define that variables must be defined manually and will never be defined automatically
Option Explicit

Sub Create_Report()

    ' Define variable names and types
    Dim chkAnn  As String   ' Check column 5 for inspection type (A13)
    Dim chkHdr  As String   ' Check column 2 for StartIspn or S/N
    Dim fmTot   As String   ' Sum the total FM area per inspection
    Dim fmNum   As Long     ' Sum the total number of FM particles per inspection
    Dim fmMin   As Long     ' Find the min FM particle size per inspection
    Dim fmMax   As Long     ' Find the max FM particle size per inspection
    Dim h       As Long     ' Row count for FM data
    Dim i       As Long     ' Row count of number of rows being processed
    Dim idCol   As String   ' Time stamp from raw data header line
    Dim idPos   As Long     ' Position of time stamp in raw data header cell
    Dim idVal   As String   ' Time stamp from ecah inspection
    Dim j       As Long     ' Row count for report data array
    Dim k       As Long     ' Row count for debug print
    Dim lRow    As Long     ' Count of number of rows in Raw Data
    Dim m       As Long     ' Row count for debug print
    Dim tsCol   As String   ' Time stamp from raw data header line
    Dim tsPos   As Long     ' Position of time stamp in raw data header cell
    Dim tsVal   As String   ' Time stamp from ecah inspection
    Dim rdA()   As Variant  ' Array of imported Raw Data for parsing
    Dim rdB()   As Variant  ' Array of processed data for report output
    Dim rdC()   As Variant  ' Temp array of FM totals
    Dim wfrSN   As String   ' Wafer serial number from line below header row
    Dim wsCol   As String   ' Time stamp from raw data header line
    Dim wsPos   As Long     ' Position of time stamp in raw data header cell
    Dim wsVal   As String   ' Time stamp from ecah inspection

    ' Clear all arrays and variables in case report is run again
    Erase rdA
    ReDim rdA(1, 1)
    Erase rdB
    ReDim rdB(1, 1)
    h = 0
    i = 0
    j = 0
    k = 0
    ' Find number of populated rows in Raw Data
    lRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row

    ' Create array of data from "Raw Data" worksheet
    rdA = Worksheets("Raw Data").Range("A1:Q1").Resize(lRow, 17).Value2

    ' PER INSPECTION GROUP
    ' Check each line of raw data and extract required info from header row
    j = 1
    For i = LBound(rdA, 1) To UBound(rdA, 1)
        chkHdr = rdA(i, 2)
        chkAnn = rdA(i, 5)
        Const Hdr = "[StartIspn]"

        ' Check row for [StartIspn] in rdA Col 2
        If InStr(1, chkHdr, Hdr, vbBinaryCompare) > 0 Then

            ' Collect Wafer Serial Number from next row and add to report array
            wfrSN = rdA(i + 1, 2)
            rdB(j, 1) = wfrSN

            ' Collect Time Stamp of inspections and add to report array
            tsCol = rdA(i, 3)
            tsPos = InStrRev(tsCol, "=")
            tsVal = Mid$(tsCol, tsPos + 1)
            rdB(j, 2) = tsVal

            ' Collect User ID and add to report array
            idCol = rdA(i, 4)
            idPos = InStrRev(idCol, "=")
            idVal = Mid$(idCol, idPos + 1)
            rdB(j, 3) = idVal

            ' Collect Wafer Side and add to report array
            wsCol = rdA(i, 6)
            wsPos = InStrRev(wsCol, "=")
            wsVal = Mid$(wsCol, wsPos + 1)
                If wsVal = "T" Then
                   wsVal = "Front"
                ElseIf wsVal = "B" Then
                       wsVal = "Back"
                End If
            rdB(j, 4) = wsVal

            ' Resize the report array for the next data set
            If j > 0 Then
            ReDim Preserve rdB(j - 1)
            End If

            ' Advance to next line in report array (rdB)
            j = j + 1

        Else
        For h = LBound(rdA, 1) To UBound(rdA, 1)
        chkAnn = rdA(h, 5)
        Const Ann = "A13"

            If InStr(1, chkAnn, Ann, vbBinaryCompare) > 0 Then

            'Collect Wafer Serial Number
            wfrSN = rdA(i, 2)
            rdC(h, 1) = wfrSN

            ' Collect FM Total
            fmTot = rdA(i, 6)
            rdC(h, 2) = fmTot

            ' Collect # of FM Particles
            fmNum = rdA(i, 8)
            rdC(h, 3) = fmNum

            ' Collect Min Particle Size
            fmMin = rdA(i, 9)
            rdC(h, 4) = fmMin

            ' Collect Max Particle Size
            fmMax = rdA(i, 10)
            rdC(h, 5) = fmMax

            ' Advance to next line in temp array (rdC)
            h = h + 1

            End If

        Next h

     Next i

    For k = LBound(rdB, 1) To UBound(rdB, 1)
        Debug.Print rdB(k, 1) & ", " & _
                    rdB(k, 2) & ", " & _
                    rdB(k, 3) & ", " & _
                    rdB(k, 4)
    Next k

    For m = LBound(rdC, 1) To UBound(rdC, 1)
        Debug.Print rdC(m, 1) & ", " & _
                    rdC(m, 2) & ", " & _
                    rdC(m, 3) & ", " & _
                    rdC(m, 4) & ", " & _
                    rdC(m, 5)
    Next m

End Sub

已更新且有效的代码：

Sub Create_Report()
    Dim vDB, vResult(), vSum1(), vSum2(), vMin(), vMax()
    Dim Ws As Worksheet, wsResult As Worksheet
    Dim s As String, i As Long, n As Long, r As Long
    Dim k As Integer

    Const Hdr = "[StartIspn]"
    Const Ann = "A13"

    Set Ws = Sheets("Raw Data")
    Set wsResult = Sheets("AOI Inspection Summary")

    vDB = Ws.Range("a1").CurrentRegion
    r = UBound(vDB, 1)

    For i = 1 To r
        If InStr(vDB(i, 2), Hdr) Then
            n = n + 1
            ReDim Preserve vResult(1 To 9, 1 To n)
            vResult(1, n) = n
            vResult(2, n) = vDB(i + 1, 2)
            vResult(3, n) = Replace(vDB(i, 3), "Time=", "")
            vResult(4, n) = Replace(vDB(i, 4), "User=", "")
            s = Replace(vDB(i, 6), "Side=", "")
            If s = "T" Then
                vResult(5, n) = "Front"
            Else
                vResult(5, n) = "Back"
            End If
            If k > 0 Then
                vResult(6, n - 1) = WorksheetFunction.Sum(vSum1)
                vResult(7, n - 1) = WorksheetFunction.Sum(vSum2)
                vResult(8, n - 1) = WorksheetFunction.Min(vMin)
                vResult(9, n - 1) = WorksheetFunction.Max(vMax)
                k = 0
            End If
        Else
            If InStr(vDB(i, 5), Ann) Then
            k = k + 1
            ReDim Preserve vSum1(1 To k)
            ReDim Preserve vSum2(1 To k)
            ReDim Preserve vMin(1 To k)
            ReDim Preserve vMax(1 To k)
            vSum1(k) = vDB(i, 6)
            vSum2(k) = vDB(i, 8)
            vMin(k) = vDB(i, 9)
            vMax(k) = vDB(i, 10)
            End If
        End If
    Next i
    vResult(6, n) = WorksheetFunction.Sum(vSum1)
    vResult(7, n) = WorksheetFunction.Sum(vSum2)
    vResult(8, n) = WorksheetFunction.Min(vMin)
    vResult(9, n) = WorksheetFunction.Max(vMax)

    With wsResult 'array Result write on sheet
        .Range("b21").CurrentRegion.Offset(2).ClearContents
        .Range("b23").Resize(n, 9) = WorksheetFunction.Transpose(vResult)
    End With
End Sub

Answer 1

尝试一下。

Sub test()
    Dim vDB, vResult(), vSum(), vMin(), vMax()
    Dim Ws As Worksheet, wsResult As Worksheet
    Dim s As String, i As Long, n As Long, r As Long
    Dim k As Integer

    Const Hdr = "[StartIspn]"

    Set Ws = Sheets("Raw Data")
    Set wsResult = Sheets("AOI Inspection Summary")

    vDB = Ws.Range("a1").CurrentRegion
    r = UBound(vDB, 1)

    For i = 2 To r '<~~ if your Raw data row 1 data is Row#, Watar S/n.... i start 2 else 1
        If InStr(vDB(i, 2), Hdr) Then
            n = n + 1
            ReDim Preserve vResult(1 To 9, 1 To n)
            vResult(1, n) = n
            vResult(2, n) = vDB(i + 1, 2)
            vResult(3, n) = Replace(vDB(i, 3), "Time=", "")   'time
            vResult(4, n) = Replace(vDB(i, 4), "User=", "")   'Positon
            s = Replace(vDB(i, 6), "Sided=", "")
            If s = "T" Then
                vResult(5, n) = "Front"
            Else
                vResult(5, n) = "Back"
            End If
            If k > 0 Then
                vResult(6, n - 1) = WorksheetFunction.Sum(vSum)
                vResult(7, n - 1) = 37 '<~~ what mean # of particle
                vResult(8, n - 1) = WorksheetFunction.Min(vMin)
                vResult(9, n - 1) = WorksheetFunction.Max(vMax)
                k = 0
            End If
        Else
            k = k + 1
            ReDim Preserve vSum(1 To k)
            ReDim Preserve vMin(1 To k)
            ReDim Preserve vMax(1 To k)
            vSum(k) = vDB(i, 6)
            vMin(k) = vDB(i, 9)
            vMax(k) = vDB(i, 10)
        End If
    Next i
    vResult(6, n) = WorksheetFunction.Sum(vSum)
    vResult(7, n) = 37 '<~~ what mean # of particle
    vResult(8, n) = WorksheetFunction.Min(vMin)
    vResult(9, n) = WorksheetFunction.Max(vMax)

    With wsResult 'array Result write on sheet
        .Range("b21").CurrentRegion.Offset(2).ClearContents
        .Range("b23").Resize(n, 9) = WorksheetFunction.Transpose(vResult)
    End With

End Sub

根据变量捕获标题行之间的数据

1 个答案: