Question

我使用Dictionary来存储数据，然后将它们转储到另一张表中。基本上我有这种格式的数据：

abc    12367

abe    23456

abe    34567

dfy    78890

我需要像这样输出：

abc    12367

abe    23456, 34567

dfy    78890

以下是存储和输出数据的代码：

Function ReadDict(ByVal wb_name As String, ByVal ws_name As String, row_begin As Integer, row_end As Integer, col As Integer) As Dictionary
On Error Resume Next

Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim dictStorage As New Dictionary

Set wbSource = Workbooks(wb_name)
If wbSource Is Nothing Then
    Set wbSource = Workbooks.Open(wb_name)
End If

Dim iRowCounter As Integer
Dim vKey, vItem As Variant

For iRowCounter = row_begin To row_end
    vKey = wbSource.Sheets(ws_name).Cells(iRowCounter, col).Value
    vItem = wbSource.Sheets(ws_name).Cells(iRowCounter, col + 1).Value

    If dictStorage.Exists(vKey) = False Then
        dictStorage.Add vKey, vItem
    Else
        dictStorage.item(vKey) = dictStorage.item(vKey) & ", " & vItem
    End If
Next iRowCounter

Set ReadDict = dictStorage
End Function

我非常确定这是有效的，因为我可以使用Debug.Print。

写函数：

Function WriteDict(ByVal wb_name As String, ByVal ws_name As String, row_begin As Integer, col As Integer, dict As Dictionary)
On Error Resume Next

If dict.Count <= 0 Then MsgBox ("Dictionary contains no item!")

Dim wbSource As Workbook
Dim wsSource As Worksheet

Set wbSource = Workbooks(wb_name)
If wbSource Is Nothing Then
    Set wbSource = Workbooks.Open(wb_name)
End If

With Worksheets(ws_name)
    Dim ky As Variant
    With dict
        Range(Cells(2, 1), Cells(2 + .Count, 1)).Value = Application.Transpose(.Keys)
        Range(Cells(2, 2), Cells(2 + .Count, 2)).Value = Application.Transpose(.Items)
    End With
End With

Set dict = Nothing
End Function

该功能仅写入键，但不写入项目。为什么？我非常喜欢这些项目，因为我可以简单地Debug.Print它们。最令人沮丧的是，如果没有读取某些行，写入函数可以正常工作，但我发誓这些行没有什么特别之处...

我列出了主要的子资料：

Sub CombineTJ()
Application.ScreenUpdating = False

Dim sSourceWB, sSourceWS, sTargetWS As String
Dim dictTJ As New Dictionary
sSourceWS = ActiveSheet.Name
sTargetWS = "Target"
sSourceWB = ActiveWorkbook.Name

Sheets.Add
ActiveSheet.Name = sTargetWS

Set dictTJ = ReadTJDict(sSourceWB, sSourceWS, 2, 8442, 1)

Call WriteTJDict(sSourceWB, sTargetWS, 2, 1, dictTJ)

Application.ScreenUpdating = True
End Sub

如果ReadTJDict（）没有读取第1950行和第2000行之间的某些行，我确信它能正常工作，但没有什么特别的。

Answer 1

好的伙计们，我已经确定了问题所在。我有一个有很长项目的键（超过255个字符）。我很确定：

Excel单元格可以容纳超过255个字符
Excel字典可以容纳超过255个字符的项目（因为我可以调试。打印此项目）

但是，出于某种原因，由于这个项目，它会破坏代码。我添加了一行来限制长度，现在一切都很好。

VBA：无法将字典项放入范围

1 个答案: