从单元格复制时省略引号

时间：2014-07-23 12:17:01

标签： excel clipboard

问题：
在程序外部从Excel复制单元格时，会自动添加双引号。

详情：
我在Windows 7计算机上使用Excel 2007。如果我有一个包含以下公式的单元格：

="1"&CHAR(9)&"SOME NOTES FOR LINE 1."&CHAR(9)&"2"&CHAR(9)&"SOME NOTES FOR LINE 2."

单元格中的输出（格式为数字）在Excel中显示如下：

1SOME NOTES FOR LINE 1.2SOME NOTES FOR LINE 2.

嗯，好。但是，如果我将单元格复制到另一个程序，例如记事本，我会在开头和结尾都会出现烦人的双引号。注意由＆＃34; CHAR（9）＆＃34;创建的选项卡。保持，这很好。 

"1  SOME NOTES FOR LINE 1.  2     SOME NOTES FOR LINE 2."

当我复制到另一个程序时，如何保持这些双引号不显示？换句话说，当单元格被复制到剪贴板时，是否可以防止这些被自动添加？

14 个答案:

答案 0 :(得分：67)

我刚遇到这个问题，用CLEAN函数包装每个单元格为我修复了它。通过执行=CLEAN(，选择您的单元格，然后自动填充列的其余部分，这应该相对容易。在我这样做之后，粘贴到记事本或任何其他程序中不再有重复的引号。

答案 1 :(得分：26)

如果您尝试粘贴到Word-Pad，Notepad ++或Word中，您将不会遇到此问题。 要将单元格值复制为纯文本，要实现您所描述的内容，您必须使用宏：

在要应用此工作簿的工作簿中（如果要在多个工作簿中使用，则在Personal.xls中），将以下代码放在标准模块中：

代码：

Sub CopyCellContents()
'create a reference in the VBE to Microsft Forms 2.0 Lib
' do this by (in VBA editor) clicking tools - > references and then ticking "Microsoft Forms 2.0 Library"
Dim objData As New DataObject
Dim strTemp As String
strTemp = ActiveCell.Value
objData.SetText (strTemp)
objData.PutInClipboard
End Sub

要将标准模块添加到项目（工作簿），请使用 Alt + F11 打开VBE，然后右键单击左上角的工作簿Project窗口并选择插入＆gt;模块。将代码粘贴到将在右侧打开的代码模块窗口中。

返回Excel，转到工具＆gt;宏＆gt;宏，然后选择名为＆＃34; CopyCellContents＆＃34;然后从对话框中选择“选项”。在这里你可以将宏分配给一个快捷键（例如像 CTRL + C 用于普通拷贝） - 我用 CTRL + Q

然后，当你想将一个单元格复制到记事本/任何地方时，只需按Ctrl + q（或你选择的任何一个）然后执行 CTRL + V 或编辑＆gt;粘贴到您选择的目的地。

我的答案是从here

复制（添加一些内容）

编辑 :(来自评论）

如果您在参考列表中找不到Microsoft Forms 2.0 Library， 你可以尝试

  • 寻找FM20.DLL（感谢@Peter Smallwood）
  • 点击浏览并选择C:\Windows\System32\FM20.dll（32位 Windows）（感谢@JWhy）
  • 点击浏览并选择C:\Windows\SysWOW64\FM20.dll （在64位上）

答案 2 :(得分：22)

首先将其粘贴到Word中，然后将其粘贴到记事本中，它将显示为不带引号

答案 3 :(得分：5)

如果您想选择多个单元格并将其值复制到剪贴板而没有所有令人讨厌的引号，则以下代码可能会有用。这是对user3616725上面给出的代码的增强。

Sub CopyCells()
 'Attach Microsoft Forms 2.0 Library: tools\references\Browse\FM20.DLL
 'Then set a keyboard shortcut to the CopyCells Macro (eg Crtl T)
 Dim objData As New DataObject
 Dim cell As Object
 Dim concat As String
 Dim cellValue As String
 CR = ""
  For Each cell In Selection
  If IsNumeric(cell.Value) Then
   cellValue = LTrim(Str(cell.Value))
  Else
   cellValue = cell.Value
  End If
  concat = concat + CR + cellValue
  CR = Chr(13)
 Next
 objData.SetText (concat)
 objData.PutInClipboard
End Sub

答案 4 :(得分：4)

当我点击引号问题时，我的解决方案是从单元格文本末尾删除回车符。由于这些回车（由外部程序插入），Excel正在为整个字符串添加引号。

答案 5 :(得分：2)

与“user3616725”的答案相关的可能问题：
我在Windows 8.1上，从“user3616725”接受的答案中链接的VBA代码似乎有问题：

Sub CopyCellContents()
 ' !!! IMPORTANT !!!:
 ' CREATE A REFERENCE IN THE VBE TO "Microsft Forms 2.0 Library" OR "Microsft Forms 2.0 Object Library"
 ' DO THIS BY (IN VBA EDITOR) CLICKING TOOLS -> REFERENCES & THEN TICKING "Microsoft Forms 2.0 Library" OR "Microsft Forms 2.0 Object Library"
 Dim objData As New DataObject
 Dim strTemp As String
 strTemp = ActiveCell.Value
 objData.SetText (strTemp)
 objData.PutInClipboard
End Sub

<强>详细信息：
运行上面的代码并将剪贴板粘贴到Excel中的单元格中我得到两个由带有问号的正方形组成的符号，如下所示：⍰⍰。粘贴到记事本中甚至都没有显示任何内容。

<强>解决方案：
经过一段时间的搜索，我找到了another VBA script from user "Nepumuk" which makes use of the Windows API。这是他最终为我工作的代码：

Option Explicit

Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long, _
    ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
    ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" ( _
    ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" ( _
    ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" ( _
    ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
    ByVal lpStr1 As Any, _
    ByVal lpStr2 As Any) As Long

Private Const CF_TEXT As Long = 1&

Private Const GMEM_MOVEABLE As Long = 2

Public Sub Beispiel()
    Call StringToClipboard("Hallo ...")
End Sub

Private Sub StringToClipboard(strText As String)
    Dim lngIdentifier As Long, lngPointer As Long
    lngIdentifier = GlobalAlloc(GMEM_MOVEABLE, Len(strText) + 1)
    lngPointer = GlobalLock(lngIdentifier)
    Call lstrcpy(ByVal lngPointer, strText)
    Call GlobalUnlock(lngIdentifier)
    Call OpenClipboard(0&)
    Call EmptyClipboard
    Call SetClipboardData(CF_TEXT, lngIdentifier)
    Call CloseClipboard
    Call GlobalFree(lngIdentifier)
End Sub

要像上面的第一个VBA代码一样使用它，请从以下位置更改Sub“Beispiel（）”：

Public Sub Beispiel()
    Call StringToClipboard("Hallo ...")
End Sub

要：

Sub CopyCellContents()
    Call StringToClipboard(ActiveCell.Value)
End Sub

并通过Excel宏菜单运行，如“user3616725”中建议的接受答案：

  

返回Excel，转到工具＆gt;宏＆gt;宏，然后选择调用的宏   “CopyCellContents”然后从对话框中选择“选项”。在这里   可以将宏指定给快捷键（例如，像Ctrl + c一样正常   复制） - 我使用了Ctrl + q。

     

然后，当您想将单个单元格复制到记事本/任何地方时，   只需按Ctrl + q（或您选择的任何内容），然后执行Ctrl + v或   编辑＆gt;粘贴到您选择的目的地。


编辑（2015年11月21日）：
来自“dotctor”的@评论：
不，这严重不是新问题！在我看来，这是对接受的答案的一个很好的补充，因为我的答案解决了在使用接受的答案中的代码时可能遇到的问题。如果我有更多的声誉，我会创建一个评论。
来自“Teepeemm”的评论：
是的，你是对的，以标题“问题：”开头的答案是误导性的。更改为：“与”user3616725“的答案相关的可能问题：”。作为评论，我当然会写得更紧凑。

答案 6 :(得分：1)

“如果您要选择 多个 单元格并将其值复制到剪贴板，而没有所有那些烦人的引号，”（ 不带 Peter Smallwood的多单元解决方案中的错误）“以下代码可能有用。”这是对Peter Smallwood上面给出的代码的增强（“是对user3616725上面给出的代码的增强”）。这修复了Peter Smallwood解决方案中的以下错误：

  • 避免出现“未定义变量”的编译器错误（此处为“ CR”-“ clibboardFieldDelimiter”）
  • 将空单元格转换为空字符串，而不是“ 0”。
  • 在每个单元格之后附加标签（ASCII 9）与CR（ASCII 13）。
  • 在每行之后附加一个CR（ASCII 13）+ LF（ASCII 10）（vs. CR（ASCII 13））

注意：您仍然无法复制单元格中嵌入的字符，这会导致您将该单元格粘贴到的目标字段退出（即，粘贴到Access的“编辑表”窗口或SSMS）。

Option Explicit

Sub CopyCellsWithoutAddingQuotes()

' -- Attach Microsoft Forms 2.0 Library: tools\references\Browse\FM20.DLL
' -- NOTE: You may have to temporarily insert a UserForm into your VBAProject for it to show up.
' -- Then set a Keyboard Shortcut to the "CopyCellsWithoutAddingQuotes" Macro (i.e. Crtl+E)

Dim clibboardFieldDelimiter As String
Dim clibboardLineDelimiter As String
Dim row As Range
Dim cell As Range
Dim cellValueText As String
Dim clipboardText As String
Dim isFirstRow As Boolean
Dim isFirstCellOfRow As Boolean
Dim dataObj As New dataObject

clibboardFieldDelimiter = Chr(9)
clibboardLineDelimiter = Chr(13) + Chr(10)
isFirstRow = True
isFirstCellOfRow = True

For Each row In Selection.Rows

    If Not isFirstRow Then
        clipboardText = clipboardText + clibboardLineDelimiter
    End If

    For Each cell In row.Cells

        If IsEmpty(cell.Value) Then

            cellValueText = ""

        ElseIf IsNumeric(cell.Value) Then

            cellValueText = LTrim(Str(cell.Value))

        Else

            cellValueText = cell.Value

        End If ' -- Else Non-empty Non-numeric

        If isFirstCellOfRow Then

            clipboardText = clipboardText + cellValueText
            isFirstCellOfRow = False

        Else ' -- Not (isFirstCellOfRow)

            clipboardText = clipboardText + clibboardFieldDelimiter + cellValueText

        End If ' -- Else Not (isFirstCellOfRow)

    Next cell

    isFirstRow = False
    isFirstCellOfRow = True

Next row

clipboardText = clipboardText + clibboardLineDelimiter

dataObj.SetText (clipboardText)
dataObj.PutInClipboard

End Sub

答案 7 :(得分：0)

要在记事本中粘贴时保持换行符，请在宏中替换此行：

strTemp = ActiveCell.Value

由：

strTemp = Replace(ActiveCell.Value, Chr(10), vbCrLf)

答案 8 :(得分：0)

请使用以下公式

=Clean("1"&CHAR(9)&"SOME NOTES FOR LINE 1."&CHAR(9)&"2"&CHAR(9)&"SOME NOTES FOR LINE 2.")

你会得到你想要的东西; - ）

答案 9 :(得分：0)

也可以通过将结果放在“清洁”功能上来删除这些双引号。

实施例： = CLEAN（“1”＆amp; CHAR（9）＆amp;“线路1的一些注意事项。”＆amp; CHAR（9）＆amp;“2”＆amp; CHAR（9）＆amp;“线路2的一些注意事项”。

输出将在没有双引号的情况下粘贴到其他程序，如Notepad ++。

答案 10 :(得分：0)

您可以通过VBA在Excel宏中执行此操作，将结果发送到文件：

Sub SimpleVBAWriteToFileWithoutQuotes()
    Open "c:\TEMP\Excel\out.txt" For Output As #1
    Print #1, Application.ActiveSheet.Cells(2, 3)
    Close #1
End Sub

如果您希望将文件名和内容分成多个文件，则可以使用以下简短代码段，避免在输出中使用双引号。

Sub DumpCellDataToTextFilesWithoutDoubleQuotes()
    ' this will work for filename and content in two different columns such as:
    ' filename column       data column
    ' 101                   this is some data
    ' 102                   this is more data

    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    Dim strFilename As String
    Dim i As Long
    Dim intFilenameColumn As Integer
    Dim intDataColumn As Integer
    Dim intStartingRow As Integer

    intFilenameColumn = 1     ' the column number containing the filenames
    intDataColumn = 3         ' the column number containing the data
    intStartingRow = 2        ' the row number to start gathering data


    For i = intStartingRow To Range("A1", Range("A1").End(xlDown)).Rows.Count

        ' copy the data cell's value
        Set rngData = Application.ActiveSheet.Cells(i, intDataColumn)

        ' get the base filename
        strFilename = Application.ActiveSheet.Cells(i, intFilenameColumn)

        ' assemble full filename and path
        strTempFile = "w:\TEMP\Excel\" & strFilename & ".txt"

        ' write to temp file
        Open strTempFile For Output As #1
        Print #1, rngData
        Close #1

    Next i

    ' goto home cell
    Application.ActiveSheet.Cells(1, 1).Select
    Range("A1").ClearOutline
End Sub

答案 11 :(得分：0)

  • 如果公式具有多行（公式中有换行符），则复制粘贴将以这种方式起作用
  • 如果可以删除多行，则复制粘贴时不会出现引号。
  • 使用@greg在先前答案中所说的 CLEAN 功能

答案 12 :(得分：0)

注意：引号的原因是，当数据从excel移到剪贴板时，它完全符合CSV标准，其中包括带制表符，换行等的引号值（双引号字符替换为两个双引号）字符）

因此，另一种方法，尤其是在OP由于制表符/换行符是由公式引起的情况下，是对制表符和硬返回使用替代字符。我对选项卡使用ascii Unit Separator = char（31），对新行使用ascii Record Separator = char（30）。

然后粘贴到文本编辑器中将不会涉及额外的CSV规则，您可以进行快速搜索并替换以再次将其转换回。

如果将制表符/换行符嵌入数据中，则可以进行搜索并替换为excel以进行转换。

无论使用公式还是更改数据，选择定界符的关键都决不要使用实际数据中可能存在的字符。这就是为什么我建议使用低级的ASCII字符的原因。

答案 13 :(得分：0)

我遇到了同样的问题，这篇文章的解决方案都没有帮助我。 然后我会分享对我来说绝对有效的解决方案，以防其他人可能遇到同样的情况。

首先，此解决方案还符合最近向 Microsoft 报告的一个错误，当用户使用文件资源管理器访问任何“快速访问文件夹”时，使用 VBA 进行任何修改后，该错误会导致剪贴板内容转换为不可读的内容。< /p> <块引用>

复制过去错误的解决方案文档，该代码将在本答案中使用，以从剪贴板中删除引号：https://docs.microsoft.com/en-us/office/vba/access/Concepts/Windows-API/send-information-to-the-clipboard

您需要构建一个如下所示的宏，并将“ctrl+c”作为热键分配给它。 （热键分配 = 开发者选项卡，宏，单击宏，选项，然后在热键字段中输入字母“c”）。

Sub ClipboardRemoveQuotes()
    Dim strClip As String
    strClip = Selection.Copy
    strClip = GetClipboard()
    On Error Resume Next - Needed in case clipboard is empty
    strClip = Replace(strClip, Chr(34), "") 
    On Error GoTo 0
    SetClipboard (strClip)
End Sub

这仍然需要您构建函数“SetClipboard”和“GetClipboard”。

下面是“SetClipboard”和“GetClipboard”函数的定义，并进行了一些调整以适应不同的excel版本。 （将下面的代码放在一个模块中）

    Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) 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 LongPtr
    Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
#Else
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare Function CloseClipboard Lib "user32.dll" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
#End If

Public Sub SetClipboard(sUniText As String)
    #If VBA7 Then
        Dim iStrPtr As LongPtr
        Dim iLock As LongPtr
    #Else
        Dim iStrPtr As Long
        Dim iLock As Long
    #End If
    Dim iLen As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
#If VBA7 Then
    Dim iStrPtr As LongPtr
    Dim iLock As LongPtr
#Else
    Dim iStrPtr As Long
    Dim iLock As Long
#End If
    Dim iLen As Long
    Dim sUniText As String
    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function

我希望它可以帮助其他人，也可以帮助我。

相关问题
最新问题