VBA复制,修改复制的内容并粘贴

问题描述 投票:0回答:1

我面临着一个小挑战,我试图在略微改变原始结构的同时实现从一列到另一列的数据复制/粘贴。应该在整个列范围内(例如B:B或C:C)作为宏来完成操作,然后再运行较大的脚本来进一步处理这些单元格。我已经完成了所有工作,但是在这部分中却很挣扎。

enter image description here

我已经在this forum上发布了这个问题,但没有成功(只是想提到上面内容,以确保我不浪费任何人的时间)

vba excel-vba
1个回答
0
投票

这可以通过在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

问候,

© www.soinside.com 2019 - 2024. All rights reserved.