首页 > 解决方案 > 循环收集标签和计算

问题描述

标签: vbaexcelloopsworksheet-function

解决方案


这需要更多的编码,您可以对其进行更多参数化,但如果您导出 excel 文件格式不会改变,那么保持简单也有好处。我计算了平均温度并将其插入您的阵列中。收集完所有数据后,您需要转置数组并将其粘贴到工作表中:

Sub GetData()

    Dim ArrPK() As String, SearchString As String
    Dim SerialNo As Range, aCell As Range
    Dim ws As Worksheet
    Dim PkCounter As Long
    'Dim LstBox As msforms.ListBox
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    SearchString = "Serial#"
    'Set LstBox = UserForm1.ListBox1

    PkCounter = 1

    With ws
        Set SerialNo = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

        For Each aCell In SerialNo
            If aCell.Value2 = SearchString Then
                ReDim Preserve ArrPK(1 To 6, 1 To PkCounter)
                ArrPK(1, PkCounter) = aCell.Offset(0, 1) 'Serial#
                ArrPK(2, PkCounter) = aCell.Offset(1, 1) 'Firmware#
                ArrPK(3, PkCounter) = aCell.Offset(3, 1) 'Capacity
                ArrPK(4, PkCounter) = aCell.Offset(3, 3) 'Technology
                ArrPK(5, PkCounter) = aCell.Offset(3, 11) 'Battery#


                'define the data block for the battery
                Set rng = aCell.CurrentRegion 'data block for one battery
                Set rng = rng.Offset(6, 0)
                Set rng = rng.Resize(rng.Rows.Count - 6, rng.Columns.Count)

                'now range is defined, run the calculations using the worksheet functions, or use a loop over the range columns
                '### calculate avg, min and max temperature (8th column in block)
                ArrPK(6, PkCounter) = Application.WorksheetFunction.Average(rng.Columns(8)) 'average temperature



                PkCounter = PkCounter + 1
            End If
        Next
    End With
End Sub

推荐阅读