Question

我想将Excel中一行的内容复制到其他行。

目前，我正在使用以下代码复制上一行的数据。

rngCurrent.Offset(-1).Copy
rngCurrent.PasteSpecial (xlPasteValues)

但我想跳过一些专栏。所以，假设有20列，我想复制除第4列和第14列之外的所有列。如何在VBA中实现？

示例：

假设以下是行中的数据。

Row to be copied........> 1 2 3 4 5 6 7 8 .... 14 15 16  
Target Row Before Copy..> A B C D E F G H .... N  O   P
Target Row After Copy...> 1 2 3 D 5 6 7 8 .... N  15 16

因此除第4列和第14列外，所有内容都被复制。请注意，目标行的第4列和第14列中的原始值D和N将被保留。

Answer 1

萨姆

我不确定您想要如何使用宏（即您是否选择了工作表中的范围或单个单元格？）但以下代码可能会帮助您入门：

编辑 - 更新了代码以反映您的评论。我添加了一个函数来检查要保留的列是否在数组中。

Sub SelectiveCopy()
'Set range based on selected range in worksheet

    Dim rngCurrent As Range
    Set rngCurrent = Selection

'Define the columns you don't want to copy - here, columns 4 and 14

    Dim RemoveColsIndex As Variant
    RemoveColsIndex = Array(4, 14)

'Loop through copied range and check if column is in array

Dim iArray As Long
Dim iCell As Long

For iCell = 1 To rngCurrent.Cells.Count
    If Not IsInArray(RemoveColsIndex, iCell) Then
        rngCurrent.Cells(iCell).Value = rngCurrent.Cells(iCell).Offset(-1, 0)
    End If
Next iCell

End Sub

Function IsInArray(MyArr As Variant, valueToCheck As Long) As Boolean
Dim iArray As Long

    For iArray = LBound(MyArr) To UBound(MyArr)
        If valueToCheck = MyArr(iArray) Then
            IsInArray = True
            Exit Function
        End If
    Next iArray

InArray = False
End Function

根据您的要求，您可以扩充此代码。例如，不是选择要复制的范围，而是可以单击行中的任何单元格，然后使用以下内容选择EntireRow，然后执行复制操作：

Set rngCurrent = Selection.EntireRow

希望这有帮助

Answer 2

尝试使用2个范围的并集：

Union(Range("Range1"), Range("Range2"))

Answer 3

另一种方式.....减少不需要。循环。

<强>假设
1.跳过列按升序排列 2.跳过列值从1开始而不是0 3.范围（“来源”）是源数据中的第一个单元格 4.范围（“目标”）是目标数据中的第一个单元格。

Sub SelectiveCopy(rngSource As Range, rngTarget As Range, intTotalColumns As Integer, skipColumnsArray As Variant)

If UBound(skipColumnsArray) = -1 Then
    rngSource.Resize(1, intTotalColumns).Copy
    rngTarget.PasteSpecial (xlPasteValues)
Else

    Dim skipColumn As Variant
    Dim currentColumn As Integer

    currentColumn = 0

    For Each skipColumn In skipColumnsArray
        If skipColumn - currentColumn > 1 Then 'Number of colums to copy is Nonzero.'
            rngSource.Offset(0, currentColumn).Resize(1, skipColumn - currentColumn - 1).Copy
            rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
        End If

        currentColumn = skipColumn
    Next

    If intTotalColumns - currentColumn > 0 Then
        rngSource.Offset(0, currentColumn).Resize(1, intTotalColumns - currentColumn).Copy
        rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
    End If

End If

Application.CutCopyMode = False

End Sub

如何致电：

SelectiveCopy Range("Source"), Range("Target"), 20, Array(1)     'Skip 1st column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array(4,5,6) 'Skip 4,5,6th column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array()      'Dont skip any column. Copy all.

感谢。

将一行复制到另一行时排除某些列

3 个答案: