使用行范围使数组变暗，并使用数组遍历 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)。

模块一如下：

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

返回“方法_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