印刷辞書のキー

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 

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エントリをカウント」ビットは、このコードを使用して作成された新しいシートで指定されたセルに印刷したいです新しいシートにテーブルをフォーマットするコードは大まかであり、理想的にはコードの最初のモジュールに組み込まれていることになります。私はそれを将来見ていきます。

私は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