Vba 基于变量在标题行之间捕获数据

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

标题行总是以[StartIspn]开头，我需要从标题行（时间戳、用户ID和side）中提取特定数据。然后我需要对下面几列行的数据求和，但只对包含“A13”的行求和“在E列中。下面的示例图像显示了原始数据的外观。在本例中，顶部灰色标题行用于定义标题之间的数据列。我的想法是，这需要循环中的循环来收集和汇总必要的数据，但我目前在尝试将数据放入临时数组时遇到了困难。我的最终目标是创建一个数组，该数组包含晶圆序列号（标题之间行的B列）、时间戳、用户ID、晶圆侧（全部来自每个标题行），以及标题行之间第6列中包含“A13”的所有行的F列之和、H列之和、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

试试这个

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

子测试（）
Dim vDB、vResult（）、vSum（）、vMin（）、vMax（）
将Ws设置为工作表，将wsResult设置为工作表
暗s为弦，i为长，n为长，r为长
将k变为整数
Const Hdr=“[StartIspn]”
设置Ws=工作表（“原始数据”）
设置wsResult=工作表（“AOI检查总结”）
vDB=Ws.范围（“a1”）.当前区域
r=UBound（vDB，1）
对于i=2到r'0，则
vResult（6，n-1）=工作表函数.Sum（vSum）
vResult（7，n-1）=37'
ReDim Preserve rdB（j-1）
使用
Preserve
时，您只能更改多维数组的最后一个维度。我必须对代码进行一些修改以使其正常工作，但您的示例明确地教会了我一种使用虚拟数据阵列的新方法，并向我展示了一种完全不同且更有效的方法。非常感谢您的指导和帮助！我发布了上面更新的代码，修改为只对包含A13的行中的数据求和，添加了vSum2对粒子数求和，并更正了Side=“Front”或“Back”的列错误和拼写错误。现在看来一切正常。再次感谢！