数组值未转置到单元格 [英] Array values not transposed to cells

问题描述

我正在尝试学习如何在Excel VBA中使用字典.测试是通过数组将A列中的1-100000行中的所有值通过字典获取，然后将所有值写入B列.这可以正常工作，直到第34464行，B列中的其余行仅获得#N/A .

I'm trying to learn how to use a dictionary in Excel VBA. The test is to get all values from rows 1-100000 in column A to a dictionary via an array and then write all the values to column B. This works fine until row 34464, the rest of the rows in column B just gets #N/A.

有什么想法吗?

Sub nnn()

'Tools - References - Microsoft Scripting Runtime
Dim myArray As Variant
Dim myRow As Long
Dim dicMyDictionary As Scripting.Dictionary
Set dicMyDictionary = New Scripting.Dictionary

With ThisWorkbook.Worksheets("Sheet1")

    myArray = Range(Cells(1, 1), Cells(100000, 1)).Value

    For myRow = LBound(myArray, 1) To UBound(myArray, 1)
        dicMyDictionary.Add myRow, myArray(myRow, 1)
    Next myRow

    myArray = dicMyDictionary.Items

    .Range("B1").Resize(dicMyDictionary.Count, 1).Value = Application.Transpose(myArray)
    Set dicMyDictionary = Nothing

End With

End Sub

推荐答案

由于工作表功能 Transpose 的局限性(另请参阅Paul Bica发布的链接)，您需要将元素分配给直接数组.以下应该可以工作:

Because of the limitations of the worksheetfunction Transpose (see also the links posted by Paul Bica), you need to assign the elements to the array directly. The following should work:

Option Explicit
Sub nnn()

'Tools - References - Microsoft Scripting Runtime
Dim myArray As Variant
Dim myRow As Long
Dim dicMyDictionary As Scripting.Dictionary
Set dicMyDictionary = New Scripting.Dictionary

With ThisWorkbook.Worksheets("Sheet1")

    myArray = Range(Cells(1, 1), Cells(100000, 1)).Value

    For myRow = LBound(myArray, 1) To UBound(myArray, 1)
        dicMyDictionary.Add myRow, myArray(myRow, 1)
    Next myRow

    ReDim myArray(1 To dicMyDictionary.Count, 1 To 1)
    For myRow = 1 To UBound(myArray, 1)
        myArray(myRow, 1) = dicMyDictionary(myRow)
    Next myRow

    .Range("B1").Resize(dicMyDictionary.Count, 1).Value = myArray
    Set dicMyDictionary = Nothing

End With

End Sub

这篇关于数组值未转置到单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！