Исключить некоторые столбцы при копировании одной строки в другую

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

Sam

Я не совсем уверен, как именно вы хотите использовать макрос (т.е. вы выбираете диапазон на листе или одну ячейку?), Но следующий код может помочь вам начать:

РЕДАКТИРОВАТЬ - код обновлен с учетом ваших комментариев. Я добавил функцию, чтобы проверить, находятся ли столбцы, которые вы хотите сохранить, в массиве.

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

Еще один способ сделать это ..... занимает меньше нет. петель.

Предположения
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.

Спасибо.

Answer 3

Попробуйте использовать объединение 2 диапазонов:

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