使用行范围来调暗数组，并使用数组迭代For循环

Question

Please look at my sample data and code to understand what I'm trying to do.

我需要使用Cells（，3）的值来定义填充Trialnumber（18）数组的范围。我需要数组迭代For循环，计算每个试验列H 中的填充单元格，并将计数打印到每个试验的最后一行中的T 列。我将来还需要阵列进行进一步的数据分析（除非有人能提出更好的解决方案）。

目前我正在试验3个代码模块，尝试获得所需的解决方案。

模块2是唯一没有错误的模块，并在右侧单元格中打印该值，但它打印的是已填充的总细胞数（562），而不是每次试验（期望值= 1或2）。

模块1如下：

Sub dotcountanalysis()
Dim startpoint As Long
startpoint = 1
Dim lastrow As Long
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long

With Worksheets("full test")

For i = 1 To 18
      For n = startpoint To lastrow + 1

        If Cells(n, 3).Value <> "Trial, " & CStr(i) Then
           Dim nMinusOne As Long
           nMinusOne = n - 1
           Dim trialCount As Long
           'Set Trialnumber(i-1) = Range(cells(startpoint, 3), cells(n-1, 3))
           trialCount = Application.WorksheetFunction.CountA(Range("H" & CStr(startpoint) & ":" & "H" & CStr(nMinusOne)))
           Range("T" & CStr(startpoint) & ":" & "T" & CStr(nMinusOne)).Value = trialCount
           startpoint = n
           Exit For
         End If

        Next n
Next i
End With
End Sub

它会在行上返回“object _range of object _global falied”错误：trialCount = Application.WorksheetFunction.CountA(Range("H" & CStr(startpoint) & ":" & "H" & CStr(nMinusOne)))

模块3如下：

Sub dotcountanalysis3()

Dim pressedCount As Long
Dim myCell As Range
Dim pressedRange As Range

'create trials array
Dim t(18) As Range

'set range for trialnumber (t)

Dim startpoint As Long
startpoint = 1
Dim lastrow As Long
lastrow = Cells(Rows.Count, 3).End(xlUp).Row

For i = 1 To 18
      For n = startpoint To lastrow
      startpoint = 7
        If Cells(n, 3).Value <> "Trial, " & CStr(i) Then
           Set t(i - 1) = Range(Cells(startpoint, 3), Cells(n, 3))
           n = n + 1
           startpoint = n
           Exit For
         End If

        Next n
Next i

'count presses in each trial

With Worksheets("full test")
    For i = 0 To 17
    pressedCount = Application.WorksheetFunction.CountA _
    (.Range(.Cells(t(), "H"), .Cells(.Rows.Count, "H")))
    If pressedCount = 0 Then Exit Sub
    'make sure there are cells or else the next line will fail
    Set pressedRange = .Columns("H").SpecialCells(xlCellTypeConstants)

        For Each myCell In pressedRange.Cells
    'only loop through the cells containing something
        .Cells(myCell.Row, "T").Value = pressedCount
        Next myCell
    Next i
End With

End Sub

它在行上返回运行时“类型不匹配”错误：pressedCount = Application.WorksheetFunction.CountA _ (.Range(.Cells(t(), "H"), .Cells(.Rows.Count, "H")))

修改：我已更新了mod 3中的代码并更新了错误。

Answer 1

在计算事物时，我喜欢使用字典对象，而数组比在工作表上逐行排列要快。

这会计算Block + Trial的独特组合：只能通过试用计算，您只需使用k = d(r, COL_TRIAL)

Dim dBT As Object 'global dictionary

Sub dotcountanalysis()

    'constants for column positions
    Const COL_BLOCK As Long = 1
    Const COL_TRIAL As Long = 2
    Const COL_ACT As Long = 7

    Dim rng As Range, lastrow As Long, sht As Worksheet
    Dim d, r As Long, k, resBT()

    Set sht = Worksheets("full test")
    lastrow = Cells(Rows.Count, 3).End(xlUp).Row
    Set dBT = CreateObject("scripting.dictionary")

    Set rng = sht.Range("B7:H" & lastrow)

    d = rng.Value  'get the data into an array

    ReDim resBT(1 To UBound(d), 1 To 1) 'resize the array which will
                                        '  be placed in ColT

    'get unique combinations of Block and Trial and counts for each
    For r = 1 To UBound(d, 1)
        k = d(r, COL_BLOCK) & "|" & d(r, COL_TRIAL) 'create key
        dBT(k) = dBT(k) + IIf(d(r, COL_ACT) <> "", 1, 0)
    Next r

    'populate array with appropriate counts for each row
    For r = 1 To UBound(d, 1)
        k = d(r, 1) & "|" & d(r, 2)   'create key
        resBT(r, 1) = dBT(k)          'get the count
    Next r

    'place array to sheet
    sht.Range("T7").Resize(UBound(resBT, 1), 1) = resBT

    'show the counts in the Immediate pane (for debugging)
    For Each k In dBT
        Debug.Print k, dBT(k)
    Next k


End Sub