在新工作表中打印字典键

这里是我的macros工作的数据的一个例子。

下面的代码使用一个字典对象计算button然后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条目”位打印到用此代码创build的新工作表中指定的单元格中：

 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来填充汇总表（可能需要检查一下“not found”情况…）

 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