Question

我正在设计一个Excel工作表，用户将单击一个复制预定范围单元格的命令按钮。然后，用户将使用Firefox或IE将内容粘贴到Web应用程序中。 Web应用程序的设计不受我的控制，目前用于数据输入的文本框是富文本输入。这会导致文本看起来很奇怪，并且在用户粘贴时会像Excel一样格式化。

Excel中是否有办法使用VBA仅复制所选单元格的纯文本？没有格式，没有表格或单元格边框，只有文本，没有别的。我当前的解决方法宏是复制单元格，打开记事本，粘贴到记事本，然后从记事本复制以获取纯文本。这是非常不受欢迎的，我希望有一种方法可以在Excel中实现这一点。请让我知道，谢谢！

Answer 1

这样的东西？

Sheet1.Cells(1, 1).Copy
Sheet1.Cells(1, 2).PasteSpecial xlPasteValues

或

selection.Copy
Sheet1.Cells(1,2).Activate
Selection.PasteSpecial xlPasteValues

Copy复制整个部分，但我们可以控制粘贴的内容。

同样适用于Range个对象。

修改

AFAIK，没有简单的方法来复制范围的文本而不将其分配给VBA对象（变量，数组等）。有一个技巧适用于单个单元格，仅适用于数字和文本（无公式）：

Sub test() Cells(1, 1).Select Application.SendKeys "{F2}" Application.SendKeys "+^L" Application.SendKeys "^C" Cells(1, 3).Select Application.SendKeys "^V" End Sub

但大多数开发人员都会避免使用SendKeys，因为它可能不稳定且不可预测。例如，上面的代码仅在从excel执行宏时才起作用，而不是从VBA执行。从VBA运行时，SendKeys打开对象浏览器，这是F2在VBA视图中按下时所执行的操作:)此外，对于全范围，您必须循环遍历单元格，复制它们逐个将它们逐个粘贴到应用程序中。现在我觉得更好，我认为这是一种矫枉过正的行为......

使用数组可能更好。这是我最喜欢的关于如何将范围传递给vba数组并返回的参考： http://www.cpearson.com/excel/ArraysAndRanges.aspx

就个人而言，我会避免SendKeys并使用数组。应该可以将数据从VBA数组传递给应用程序，但如果不了解有关应用程序的更多信息，很难说。

Answer 2

实际上，最好的方法是复制单元格并粘贴到记事本中。记事本无法识别单元格。然后，您可以将文本复制回所需的任何单元格。这适用于将文本从多个单元格复制到单个单元格中。

Answer 3

尝试复制您选择的任何单元格：

Sub CopyTheCell()
Dim TheText As String
TheText = Selection
ToClipboard TheText
End Sub

Function ToClipboard(Optional StoreText As String) As String
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)

Dim x As Variant

'Store as variant for 64-bit VBA support
  x = StoreText

'Create HTMLFile Object
  With CreateObject("htmlfile")
    With .parentWindow.clipboardData
      Select Case True
        Case Len(StoreText)
          'Write to the clipboard
            .setData "text", x
        Case Else
          'Read from the clipboard (no variable passed through)
            Clipboard = .GetData("text")
      End Select
    End With
  End With

End Function

Answer 4

如果您正在处理要复制的大量单元格，则selection.copy方法将非常慢。（我在200 000条记录上运行宏时经历过这种情况。）

性能提高100倍的方法是直接将一个单元格的值分配给另一个单元格。我的代码示例：

With errlogSheet
         'Copy all data from the current row

          reworkedErrorSheet.Range("A" & reworkedRow).Value = .Range("A" & currentRow).Value
          reworkedErrorSheet.Range("B" & reworkedRow).Value = .Range("B" & currentRow).Value
          reworkedErrorSheet.Range("C" & reworkedRow).Value = .Range("C" & currentRow).Value
          reworkedErrorSheet.Range("D" & reworkedRow).Value = .Range("D" & currentRow).Value
          reworkedErrorSheet.Range("E" & reworkedRow).Value = .Range("E" & currentRow).Value

Answer 5

这可以很容易地解决而不用打扰VBA。

用户可以通过 Ctrl + Shift + V 而不是更常见的 Ctrl + V （格式化粘贴）。

Ctrl + Shift + V 将剪贴板内容粘贴为纯文本。

Answer 6

在Excel 2013中，您可以使用快捷方式执行此操作。

按 Ctrl + Alt + V 打开粘贴特殊窗口。现在，您可以单击值单选按钮，或者只需按 V （如果您的Excel是英语）。如果您不在英语中使用Excel，您可以通过查看单个字母的下划线来查看可以按哪个按钮来选择想要的选项。

最后按 Enter 粘贴复制的选区。

Answer 7

在Excel中，突出显示相关单元格。点击F2。 CTRL + SHIFT + HOME。（这突出了单元格的全部内容。） CTRL + C。转到目标应用程序。 CTRL + V。它看起来像很多步骤，但是当你真正做到这一步时，它比使用色带来完成同样的事情要快得多。

如果您需要将多个单元格复制到禁用“粘贴特殊...”工具的应用程序中，请执行常规复制并从Excel粘贴到记事本中，然后从记事本复制并粘贴到目标。既麻烦又有效。

Answer 8

要完成此操作，我将选择的单元格复制到剪贴板，将剪贴板保存到文本变量，然后将文本复制回剪贴板。

将以下内容复制到新模块中，然后运行最后一个子程序：

'Handle 64-bit and 32-bit Office
#If VBA7 Then
  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 LongPtr, _
    ByVal dwBytes As LongPtr) As LongPtr
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
  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 lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As LongPtr
  Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, _
    ByVal hMem As LongPtr) As LongPtr
#Else
  Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
    ByVal dwBytes As Long) As Long
  Private Declare Function CloseClipboard Lib "user32" () As Long
  Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function EmptyClipboard Lib "user32" () As Long
  Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
    ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
    As Long, ByVal hMem As Long) As Long
#End If

Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096

Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
'Link: https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard

#If VBA7 Then
  Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
  Dim hClipMemory As LongPtr, x As LongPtr
#Else
  Dim hGlobalMemory As Long, lpGlobalMemory As Long
  Dim hClipMemory As Long, x As Long
#End If

'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 Function
  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."
  End If

End Function

Function ClipBoard_GetData() As String
' Return the data in clipboard as text
' Source: https://docs.microsoft.com/en-us/office/vba/access/concepts/windows-api/retrieve-information-from-the-clipboard
#If VBA7 Then
   Dim lpGlobalMemory As LongPtr, hClipMemory As LongPtr
   Dim lpClipMemory As LongPtr
   Dim RetVal As LongPtr
#Else
   Dim lpGlobalMemory As Long, hClipMemory As Long
   Dim lpClipMemory As Long
   Dim RetVal As Long
#End If
   Dim MyString As String
 
   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open"
      Exit Function
   End If
          
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo OutOfHere
   End If
 
   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)
 
   If Not IsNull(lpClipMemory) Then
      If lpClipMemory <> 0 Then
        MyString = Space$(MAXSIZE)
        RetVal = lstrcpy(MyString, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
         
        ' Peel off the null terminating character.
        MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
      Else
        MsgBox "Clipboard is empty!"
      End If
   Else
      MsgBox "Could not lock memory to copy string from."
   End If

OutOfHere:

   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
End Function

Sub CopySelectedCellsAsText()
' Copy selected cells to clipboard, save the clipboard to a text variable,
'    and then copy this text back to clipboard
    If TypeName(Selection) <> "Range" Then Exit Sub
    Selection.Copy
    Dim strSelection As String
    strSelection = ClipBoard_GetData
    Application.CutCopyMode = False
    ClipBoard_SetData strSelection
End Sub

Answer 9

这对我来说只复制了日期列中的文本值

Worksheets("Shee1").Cells(2, "A").Text

如何只复制Excel中的单元格的纯文本？

9 个答案: