1

我有一个宏，可以将剪贴板中的多行数据粘贴到选定的单元格中。它将为每一行插入新行。列 A 和 Row1 包含标题，它将为任何插入的行填充它。

Sheet1
Header0 Header  Header  Header
Header1 Data        
Header2 Data    Data1
                Data2   Data
Header3 Data

有时它会添加额外的 "" 引号，有时则不会。有没有办法在不删除合法引号字符的情况下清理剪贴板数据？

单元格内容数组

Sub ClipboardToRows()
' Split multi-lined data into separate rows for the current selection
' Assumption is that Column A contains row headers
Dim currRange As Range, currCell As Range, pasteCell As Range
Dim rowHeader As String
Dim cellContent
Dim cellStr

Dim clipboard As MSForms.DataObject
Dim str1 As String
Set clipboard = New MSForms.DataObject

clipboard.GetFromClipboard
On Error GoTo clipEmpty
str1 = Trim(clipboard.GetText())

Application.CutCopyMode = False
Set currCell = Selection

rowHeader = Cells(currCell.Row, 1).Value
'Skip Column A
If (currCell.Column > 1) Then
    cellContent = Split(str1, Chr(10))
    For i = LBound(cellContent) To (UBound(cellContent))
        cellStr = Trim(cellContent(i))
        If Len(cellStr) > 0 Then
            Set pasteCell = currCell.Offset(i)
            'Set current cell with line 1
            If i = 0 Then
                currCell.Value = cellContent(i)
            Else
                'If next cell down is not empty or the row header is different
                If (Not IsEmpty(pasteCell.Value)) Or (Cells(pasteCell.Row, 1).Value <> rowHeader) Then
                    pasteCell.EntireRow.Insert
                    Cells(pasteCell.Row - 1, 1).Value = rowHeader
                End If
                currCell.Offset(i).Value = cellContent(i)

            End If
        End If
    Next
End If

clipEmpty:
    If Err <> 0 Then MsgBox "There was an issue with pasting. Please try again."

End Sub
4

1 回答 1

0

并不真地。

如果在复制过程中将双引号不一致地添加到剪贴板，并且您想要保留的源数据中有合法引号，则无法仅查看剪贴板中的当前内容来确定原始数据中的内容数据以及复制过程中添加的内容。

您可以做的最好的事情是尝试识别任何错误添加的引号模式并尝试删除它们。

例如，测试每个值以确定开头和/或结尾是否有双引号，在这种情况下，从该值中删除第一个和/或最后一个字符。

于 2017-02-08T02:03:35.943 回答