Fatal编程技术网
  • excel/
  • Excel 从单元格复制时，请省略引号

Excel 从单元格复制时，请省略引号

excel

Excel 从单元格复制时，请省略引号,excel,clipboard,Excel,Clipboard,问题： 在程序外部从Excel复制单元格时，会自动添加双引号 详细信息： 我正在Windows7计算机上使用Excel2007。如果我有一个具有以下公式的单元格： ="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 NOTE

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

详细信息：
我正在Windows7计算机上使用Excel2007。如果我有一个具有以下公式的单元格：

="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.
很好。但是，如果我将单元格复制到另一个程序中，例如记事本，我会在开始和结束时得到恼人的双引号。请注意，由“CHAR（9）”创建的选项卡被保留，这很好

"1  SOME NOTES FOR LINE 1.  2     SOME NOTES FOR LINE 2."
当我复制到另一个程序时，如何防止这些双引号出现？换句话说，当单元格复制到剪贴板时，我是否可以防止自动添加这些单元格？

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

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

代码：

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

返回Excel，转到工具>宏>宏，选择名为“CopyCellContents”的宏，然后从对话框中选择选项。在这里，您可以将宏指定给快捷键（如CTRL+C用于普通复制）-我使用了CTRL+Q

然后，当您想将单个单元格复制到记事本/任何位置时，只需执行Ctrl+q（或您选择的任何操作），然后在您选择的目标位置执行Ctrl+V或Edit>Paste

我的答案（加上一些补充）抄袭自：

编辑（来自评论）

如果在“引用”列表中找不到Microsoft Forms 2.0库， 你可以试试

  • 改为寻找FM20.DLL（谢谢@Peter Smallwood）
  • 单击浏览并选择
    C:\Windows\System32\FM20.dll
    （32位 （谢谢@JWhy）
  • 单击浏览并选择
    C:\Windows\SysWOW64\FM20.dll
    （在64位上）
我刚刚遇到了这个问题，用
CLEAN
函数包装每个单元格，为我解决了这个问题。通过执行
=CLEAN，这应该相对容易做到（
，选择您的单元格，然后自动填充列的其余部分。完成此操作后，粘贴到记事本或任何其他程序中不再有重复的引号。

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

要在粘贴到记事本时保持换行，请在m中替换这一行acro：

strTemp = ActiveCell.Value
作者：

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

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

解决方案：
经过一段时间的搜索，我找到了。以下是他的代码，最终对我有用：

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代码一样使用它，请将子“Beispiel（）”更改为：

致：

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

返回Excel，转到工具>宏>宏，然后选择名为 “CopyCellContents”，然后从对话框中选择选项 可以将宏指定给快捷键（如Ctrl+c表示普通 复制）-我使用Ctrl+q

然后，当您要将单个单元格复制到记事本/任何位置时， 只需执行Ctrl+q（或您选择的任何操作），然后执行Ctrl+v或 编辑>粘贴到您选择的目的地


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

请使用以下公式

=Clean("1"&CHAR(9)&"SOME NOTES FOR LINE 1."&CHAR(9)&"2"&CHAR(9)&"SOME NOTES FOR LINE 2.")
你会得到你想要的；-）

如果你想选择多个单元格，并将它们的值复制到剪贴板上，而不使用那些讨厌的引号，下面的代码可能会很有用。这是上面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
当我遇到引号问题时，我的解决方案是从单元格文本的末尾去掉回车符。由于这些回车符（由外部程序插入），Excel将向整个字符串添加引号。

也可以通过将结果放在“Clean”函数上来删除这些双引号

例如：

=CLEAN("1"&CHAR(9)&"SOME NOTES FOR LINE 1."&CHAR(9)&"2"&CHAR(9)&"SOME NOTES FOR LINE 2.")
输出将在其他程序（如记事本++）上粘贴，不带双引号。

“如果您想选择多个单元格，并将其值复制到剪贴板，而不带所有那些讨厌的引号”（不带彼得·斯莫尔伍德的多单元格解决方案中的bug），“以下代码可能会有用。”这是Peter Smallwood对上述代码的增强（这是“对上述user3616725代码的增强”）。这修复了Peter Smallwood解决方案中的以下错误：

  • 避免“变量未定义”编译器错误（此处为“CR”-“clibboardFieldDelimiter”）
  • 将空单元格转换为空字符串而不是“0”
  • 附加T 
    Public Sub Beispiel()
    Call StringToClipboard("Hallo ...")
End Sub

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

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

    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

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

    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

    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

    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

        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