VBA技术问题：无法将Dictionary数据写入单元格区域

看起来你需要把带有重复键的原始数据，通过Dictionary合并重复项的值，再导出到其他工作表。先明确你的需求：

原始数据（每行一个键值对）：
abc 12367
abe 23456
abe 34567
dfy 78890
期望输出（合并重复键的多个值）：
abc 12367
abe 23456, 34567
dfy 78890

下面是完整的实现代码，包含数据读取、字典合并、导出三个核心部分，我补全了你未写完的ReadDict函数，并添加了导出逻辑：

完整代码 #

' 注意：可以提前引用Microsoft Scripting Runtime（工具→引用→勾选），或者用CreateObject方式初始化字典
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 GoTo ErrorHandler ' 替换On Error Resume Next为更严谨的错误处理
    
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim dictStore As Dictionary
    ' 兼容性写法：无需引用库
    Set dictStore = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    Dim cellValue As String
    Dim keyValArr() As String
    
    ' 获取源工作簿和工作表
    If wb_name = ThisWorkbook.Name Then
        Set wbSource = ThisWorkbook
    Else
        Set wbSource = Workbooks.Open(wb_name)
    End If
    Set wsSource = wbSource.Worksheets(ws_name)
    
    ' 遍历指定行范围处理数据
    For i = row_begin To row_end
        cellValue = Trim(wsSource.Cells(i, col).Value)
        If cellValue <> "" Then
            ' 按空格拆分键和值，限制拆分2次避免值含空格
            keyValArr = Split(cellValue, " ", 2)
            If UBound(keyValArr) = 1 Then
                Dim keyStr As String, valStr As String
                keyStr = Trim(keyValArr(0))
                valStr = Trim(keyValArr(1))
                
                ' 合并重复键的值
                If dictStore.Exists(keyStr) Then
                    dictStore(keyStr) = dictStore(keyStr) & ", " & valStr
                Else
                    dictStore.Add keyStr, valStr
                End If
            End If
        End If
    Next i
    
    Set ReadDict = dictStore
    Exit Function
    
ErrorHandler:
    MsgBox "读取数据出错：" & Err.Description, vbExclamation
    Set ReadDict = Nothing
    If Not wbSource Is Nothing And wbSource.Name <> ThisWorkbook.Name Then
        wbSource.Close SaveChanges:=False
    End If
End Function

' 将处理后的字典导出到目标工作表
Sub ExportDictToSheet(dict As Dictionary, targetWs As Worksheet, startRow As Integer, startCol As Integer)
    If dict Is Nothing Then Exit Sub
    
    Dim key As Variant
    Dim outputRow As Integer
    outputRow = startRow
    
    ' 遍历字典写入数据
    For Each key In dict.Keys
        targetWs.Cells(outputRow, startCol).Value = key & " " & dict(key)
        outputRow = outputRow + 1
    Next key
    
    MsgBox "数据导出完成！", vbInformation
End Sub

' 调用示例：按需修改参数
Sub RunProcess()
    Dim dataDict As Dictionary
    Dim targetWorksheet As Worksheet
    
    ' 读取源数据生成字典：参数（工作簿名，源工作表名，起始行，结束行，列号）
    Set dataDict = ReadDict(ThisWorkbook.Name, "原始数据", 1, 4, 1)
    
    ' 指定目标工作表
    Set targetWorksheet = ThisWorkbook.Worksheets("导出结果")
    
    ' 导出数据到目标表的A1开始位置
    If Not dataDict Is Nothing Then
        ExportDictToSheet dataDict, targetWorksheet, 1, 1
    End If
End Sub

关键细节说明 #

• 字典初始化：用CreateObject("Scripting.Dictionary")不需要提前引用库，兼容性更强；如果追求代码提示可以勾选Microsoft Scripting Runtime引用。
• 数据拆分逻辑：Split(cellValue, " ", 2)限制拆分次数为2，确保即使值里有空格（比如abe 23456 789），也能正确提取键和完整的值。
• 重复键合并：通过dictStore.Exists(keyStr)判断键是否已存在，存在则追加新值（用, 分隔），不存在则添加新键值对。
• 错误处理：添加了工作簿关闭逻辑（如果是外部工作簿），避免遗留打开的文件。

使用方法 #

1. 把你的原始数据放在Excel的指定工作表（比如命名为「原始数据」）的某一列，每行一个键值对。
2. 修改RunProcess子过程里的参数，匹配你的源数据位置和目标工作表名。
3. 运行RunProcess宏即可完成处理和导出。

内容的提问来源于stack exchange，提问作者Nicholas Humphrey