字典键分配明智的

Question

我有词典对象Dic1，Dic2，其中的项目是一个字母表。说

 Dic1(10)= A 
    Dic1(111)= B 
    Dic1(12)= C like this. 


    Dic2(125)= A 
    Dic2(131)= B 
    Dic2(126)= C like this. 

现在我将尝试通过以下在Excel中的行（第3列起）的循环来分配自己的钥匙，但不是所有的按键都得到复制。

objSheet2.Range("C"&nRow).Value=Dic1.Keys() Or(condition wise any of the assignment 
    will be executed) 

    objSheet2.Range("C"&nRow).Value=Dic2.Keys() 

但只有第一个Key值被复制，忽略了其他值。你能告诉我的代码中有什么Bug吗？

编辑

Option Explicit 

Class cP 
Public m_sRel 
Public m_dicC 
    Private Sub Class_Initialize() 
    m_sRel  = "Child" 
    Set m_dicC = CreateObject("Scripting.Dictionary") 
    End Sub 

    Public Function show() 
    show = m_sRel & " " & Join(m_dicC.Keys) 
    End Function 

End Class 

Dim objSheet1,objSheet2,TotalRows,TotalcolCopy,strPathExcel1 
'Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject") 
Dim oXls : Set oXls = CreateObject("Excel.Application") 
'Dim aData ': aData = oWb.Worksheets(1).Range("$A2:$C10") 
Dim dicP : Set dicP = CreateObject("Scripting.Dictionary") 
Dim nRow,nP,sKeys 

strPathExcel1 = "D:\WIPData\AravoMacro\Finalscripts\A.xlsx" 
oXls.Workbooks.open strPathExcel1 
'oXls.Workbooks.Open(oFs.GetAbsolutePathName("A.xlsx")) 
Set objSheet1 = oXls.ActiveWorkbook.Worksheets("WingToWingMay25") 
Set objSheet2 = oXls.ActiveWorkbook.Worksheets("ParentChildLink") 


TotalRows=oXls.Application.WorksheetFunction.CountA(objSheet1.Columns(1)) 
TotalcolCopy=oXls.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0) 

objSheet1.Range(objSheet1.Cells(4,1),objSheet1.Cells(TotalRows,TotalcolCopy)).Copy(objSheet2.Range("A1")) 
objSheet2.Range(objSheet2.Cells(1,2),objSheet2.Cells(TotalRows,TotalcolCopy-1)).Delete(-4159) 
'Dim aData : aData=objSheet2.Cells.SpecialCells(12)'xlCellTypeVisible 

Dim aData : aData = objSheet2.Range("A1:B"&TotalRows-3) 

'MsgBox(LBound(aData, 1)&"And"&UBound(aData, 1)) 

    For nRow = LBound(aData, 1) To UBound(aData, 1) 

    Set dicP(aData(nRow, 1)) = New cP 
    'Set dicP(aData(nRow, 2)) = New cP 

    Next 
    'objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2 
    'sKeys=dicP.Keys 
    'objSheet2.Range("A1").Resize(dicP.Count) = oXls.Application.Transpose(sKeys) 
    'MsgBox(dicP.Count&":"&UBound(aData, 1)&":"&LBound(aData, 1)) 
    For nRow = LBound(aData, 1) To UBound(aData, 1) 

     If aData(nRow, 1) = aData(nRow, 2) Then 
      dicP(aData(nRow, 1)).m_sRel = "Parent" 
     Else 
      If dicP.Exists(aData(nRow, 2)) Then 

      dicP(aData(nRow, 2)).m_dicC.Add aData(nRow, 1), 0  '(aData(nRow, 1)) = 0 

      End If 
     End If 

    Next 

    objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2 

    nRow=1 
    For Each nP In dicP.Keys() 

    objSheet2.Cells(nRow,1).Value=nP 
    objSheet2.Cells(nRow,2).Value=dicP(nP).m_sRel 
    objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys() 
    'Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys() 
    nRow=nRow+1 
    Next 

我在该行objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys()

感谢得到一个错误的Unknown Run time error，

Answer 1

是的，你分配一个数组只有一个细胞。然后只复制第一个值。
您必须将数组分配到正确大小的范围。这可以通过Range.Resize完成。 然后Excel再次将数组视为一个二维数组（矩阵），并且如果它只是一维的，这将始终被视为第一行。如果将其复制到垂直范围内，则每个单元格将具有相同的阵列第一个元素。
对于垂直范围，你要转你的阵列/虚拟矩阵：

Sub test() 
    Dim d 
    Dim nRow As Long 

    nRow = 3 
    Set d = CreateObject("Scripting.Dictionary") 
    d(1) = "A" 
    d(2) = "B" 
    d(17) = "C" 
    d(32) = "F" 

    ' horizontal: 
    Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys() 

    ' vertical insert needs the data transformed 
    Range("C" & nRow).Resize(UBound(d.Keys()) + 1).Value = WorksheetFunction.Transpose(d.Keys()) 

End Sub 

为了您的编辑，你可能首先需要纠正("C"&nRow)到("C" & nRow)。这些空间是必需的。
另一个错误是Resize(1 + ... + 1)，所以你加了+2，但是这不应该引发错误。