在将一行拷贝到其他列时排除一些列

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。注意，原始值d和N列4和目标行的14被保留。

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.范围（“Source”）是源数据中的第一个单元格。
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. 

感谢。