复制、修改复制的内容并粘贴答案

【问题标题】：Copy, modify the copied content and paste复制、修改复制的内容并粘贴
【发布时间】：2020-05-11 05:24:01
【问题描述】：

我面临一个小挑战，我正在尝试将数据从一列复制/粘贴到另一列，同时稍微改变原始结构。这应该在整个列范围（例如 B:B 或 C:C）中作为宏在更大的脚本进一步操作这些单元格之前运行。我已经完成了所有工作，但正在为这部分努力。

我已经在this forum 发布了这个问题，但没有成功（只是想提一下以上内容以确保我不会浪费任何人的时间）

【问题讨论】：

请直接在此处发布图片和代码。随着时间的推移，外部来源并不可靠
我怀疑您是否能够使用 Excel 对象模型来操作剪贴板上的数据。您可以做的是创建一个隐藏的工作簿或“非常隐藏”的工作表，将数据粘贴到那里，对其进行操作，然后将其复制/粘贴到目标范围。

【解决方案1】：

这可以通过循环 VBA 中的行来完成，从列 A 和 B 中删除所有旧数据，然后使用一些字符串操作从列 C 和 D 中添加数据。这样的事情应该可以帮助您开始：

Sub sAddData()
    On Error GoTo E_Handle
    Dim ws As Worksheet
    Dim lngLastRow As Long
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim aInData() As String
    Dim aOutData() As String
    Dim strData As String
    Set ws = Worksheets("Sheet4")
    lngLastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    For lngLoop1 = 2 To lngLastRow
'   deal with adding info from column D to column A
        aOutData() = Split(ws.Cells(lngLoop1, 1), ";")
        strData = ""
        For lngLoop2 = LBound(aOutData) To UBound(aOutData)
            If Left(aOutData(lngLoop2), 3) <> "ADD" Then strData = strData & aOutData(lngLoop2) & ";"
        Next lngLoop2
        aInData() = Split(ws.Cells(lngLoop1, 4), ";")
        For lngLoop2 = LBound(aInData) To UBound(aInData)
            Select Case Left(aInData(lngLoop2), 4)
                Case "{S1}", "{S6}", "{S10"
                    strData = strData & Mid(aInData(lngLoop2), InStr(aInData(lngLoop2), "}") + 1) & ";"
            End Select
        Next lngLoop2
        If Right(strData, 1) = ";" Then strData = Left(strData, Len(strData) - 1)
        ws.Cells(lngLoop1, 1) = strData

'   deal with adding info from column C to column B
        strData = ""
        strData = ws.Cells(lngLoop1, 2)
        If Left(strData, 4) = "[NUM" Then strData = Mid(strData, InStr(strData, ".") + 2)
        If Len(ws.Cells(lngLoop1, 3)) > 0 Then
            strData = "[NUM - " & Replace(ws.Cells(lngLoop1, 3), "*", ", ") & "]. " & strData
        End If
        ws.Cells(lngLoop1, 2) = strData
    Next lngLoop1
sExit:
    On Error Resume Next
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sAddData", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

问候，

【讨论】：

非常感谢你们！将尽快对其进行测试并询问 - 我是否需要任何进一步的帮助！保持健康！