打印辭典鍵

Question

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

下面的代碼使用Dictionary對象來算按下按鈕，然後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 

我現在想要的代碼的「算AOI條目」位打印到新的工作表指定的細胞與此代碼創建：

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