在將一行拷貝到其他列時排除一些列

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. 

感謝。