Question

Here is a sample of the data my macros work on.

以下代码使用字典对象计算按钮然后按AOI条目，然后将计数打印到同一工作表上的其他列：

Dim dBT As Object 'global dictionary

Sub buttonpresscount()

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

    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:I" & 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 pressedcounts 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

    'clear dictionary
    dBT.RemoveAll

'count AOI entries
 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_AOI) = "AOI Entry", 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("U7").Resize(UBound(resBT, 1), 1) = resBT

End Sub

我现在想要＆＃34;计算AOI条目＆＃34;在使用以下代码创建的新工作表中打印到指定单元格的代码位：

Sub createsummarytable()
'add new worksheet to data
Dim datasummary As Worksheet

With ThisWorkbook.Worksheets.Add
.Name = "datasummary"

Dim i As Long
Dim j As Long
Dim t As Long
Dim Startrow As Long

Startrow = -4
t = 1

'print Block number headings
For i = 1 To 40
    If i < 31 Then
    .Cells(Startrow + (5 * i), 1).Value = "Block " & i

    Else     'print transfer block headings

    .Cells(Startrow + (5 * i), 1).Value = "Transfer Block " & t
    t = t + 1
    End If

 'print trial number headings
    For j = 1 To 18
    .Cells((Startrow + 1) + (5 * i), j).Value = "Trial, " & j
    Next j
Next i

End With
End Sub

我知道在新工作表中格式化表格的代码很粗糙，理想情况下会将其合并到第一个代码模块中。我将来会研究这个问题。

我希望AOI条目计入到试验下面的第一行，但不知道如何将每个试验的计数分开并阻塞到不同的行和列。

Answer 1

'....
'clear dictionary
dBT.RemoveAll

'count AOI entries
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_AOI) = "AOI Entry", 1, 0)
Next r

createsummarytable

PopSummary dBT

填充摘要表的子（可能需要对“未找到”案例进行一些检查......）

Sub PopSummary(dict)

    Dim sht As Worksheet, k, b, t, f, f2

    Set sht = ThisWorkbook.Sheets("datasummary")

    For Each k In dict

        b = Split(k, "|")(0) 'get block
        t = Split(k, "|")(1) 'get trial
        'find the block
        Set f = sht.Columns(1).Find(what:=b, lookat:=xlWhole, LookIn:=xlValues)
        If Not f Is Nothing Then
            'find the trial under that block
            Set f2 = f.Offset(1, 0).EntireRow.Find(what:=t, lookat:=xlWhole, LookIn:=xlValues)
            If Not f2 Is Nothing Then f2.Offset(1, 0).Value = dict(k)
        End If
    Next k

End Sub

在新工作表中打印字典键

1 个答案: