如何将Excel单元格内容复制为单个长字符串（VBA宏问题）

我写了一个Excel VBA宏，用来把物料ID复制到公司ERP系统。其他功能都正常，但复制出来的内容是换行排列的，没法被ERP识别。我需要把数据合并成单个逗号分隔的字符串。

期望效果 #

7042151,7042152,7042153,7042154,7042145,7042155,7025449,3012928,3006999,3002768,3002761,3002768,3010873,3008762,3001228,3002761,3760114

实际效果 #

7042151,
7042152,
7042153,
7042154,
7042145,
7042155,
7025449,
3012928,
3006999,
3002768,
3002761,
3002768,
3010873,
3008762,
3001228,
3002761,
3760114

现有代码 #

Sub copytext()
    Dim txt As Worksheet
    Dim rng As Range
    Dim Last_Col As Long
    Dim LastRow As Integer
    Set rng = Application.Selection
    Application.Workbooks.Add
    Set txt = Application.ActiveSheet
    rng.Copy
    Application.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    With Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(-1, 0))
      .Value = Evaluate(Replace("if(@<>"""",@&"","")", "@", .Address))
    End With
    Range("A1").NumberFormat = "@"
    LastRow = ActiveSheet.UsedRange.Rows.Count
    ActiveSheet.Range("A1:A" & LastRow).Select
    Range("A1").Value = Application.WorksheetFunction.Clean(Range("A1"))
    Selection.Copy
End Sub

预期流程：选中含数据的单元格，点击宏，宏将格式正确的内容复制到剪贴板。

我在Selection.Copy后试过这段代码，但结果还是一样：

Dim objData As New MSForms.DataObject
    Dim strText As String
    objData.GetFromClipboard
    strText = objData.GetText
    objData.SetText strText
    objData.PutInClipboard

你的核心问题是没有把多行数据合并成单行字符串，而是直接复制了多行内容。可以简化流程，直接遍历选中单元格拼接字符串，再写入剪贴板，不需要新建工作簿。

方案一：使用MSForms.DataObject（需添加引用） #

Sub CopyMaterialIDs()
    Dim rng As Range
    Dim cell As Range
    Dim resultStr As String
    
    Set rng = Application.Selection
    ' 遍历选中单元格，拼接逗号分隔的字符串
    For Each cell In rng
        If cell.Value <> "" Then ' 跳过空单元格
            If resultStr <> "" Then
                resultStr = resultStr & ","
            End If
            resultStr = resultStr & cell.Value
        End If
    Next cell
    
    ' 将字符串写入剪贴板
    Dim objData As New MSForms.DataObject
    objData.SetText resultStr
    objData.PutInClipboard
    
    MsgBox "已复制到剪贴板：" & resultStr ' 可选提示，验证内容
End Sub

引用添加步骤 #

如果运行时提示“用户定义类型未定义”，需手动添加引用：

• 打开VBA编辑器（Alt+F11）
• 点击【工具】→【引用】
• 勾选Microsoft Forms 2.0 Object Library，点击确定。

方案二：使用Windows API（无需额外引用） #

如果不想添加引用，用系统API实现剪贴板操作：

Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Boolean
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Boolean
Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Boolean
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal uFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Boolean
Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr

Sub CopyMaterialIDs_NoReference()
    Dim rng As Range
    Dim cell As Range
    Dim resultStr As String
    
    Set rng = Application.Selection
    For Each cell In rng
        If cell.Value <> "" Then
            If resultStr <> "" Then
                resultStr = resultStr & ","
            End If
            resultStr = resultStr & cell.Value
        End If
    Next cell
    
    ' 调用API复制到剪贴板
    CopyTextToClipboard resultStr
    MsgBox "已复制到剪贴板：" & resultStr
End Sub

Private Sub CopyTextToClipboard(text As String)
    Dim hGlobalMemory As LongPtr
    Dim lpGlobalMemory As LongPtr
    
    ' 分配全局内存存储字符串
    hGlobalMemory = GlobalAlloc(&H2000, Len(text) * 2 + 2)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lstrcpy lpGlobalMemory, StrPtr(text)
    GlobalUnlock hGlobalMemory
    
    ' 打开剪贴板并写入内容
    OpenClipboard 0&
    EmptyClipboard
    SetClipboardData(&H1, hGlobalMemory)
    CloseClipboard
End Sub

内容的提问来源于stack exchange，提问作者Daniel Synek