如何将Excel中的单元格复制到一长串

Question

我尝试制作一些简单的 Excel makro 来复制 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

它的工作方式应该就像突出显示带有数据的单元格，单击 makro，然后 makro 以正确的格式复制到剪贴板。

我在

Selection.Copy

之后尝试过这个，但结果是一样的。

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

Answer 1

如果您使用的是 Excel 365，则可以使用

TextJoin

函数加上 API 调用剪贴板 (https://stackoverflow.com/a/21314039/16578424)

Sub copyToString(rg As Range)

Dim t As String
t = Application.WorksheetFunction.TextJoin(",", True, rg)

ClipBoard_SetData t
End Sub

如果您使用的是 64 位 Windows，则必须使用这些 API 声明 - 将其放入新模块中，例如

mdlClipboard

：

Option Explicit
'http://stackoverflow.com/questions/14738330/office-2013-excel-putinclipboard-is-different

Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr


Private Const GHND  As Long = &H42
Private Const CF_TEXT As Long = 1

Public Sub ClipBoard_SetData(MyString As String)
    Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr, hClipMemory As LongPtr
   Dim X As Long
   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted. "
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Sub
   End If

   ' Clear the Clipboard.
   X = EmptyClipboard()

   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard. P"
   End If

End Sub