Скопируйте каждые три ячейки в столбце с одного листа и вставьте на другой лист - PullRequest
0 голосов
/ 11 октября 2018

Я видел сообщения о копировании диапазона данных и вставке с добавленными пробелами, но мне нужно что-то более сложное.

У меня есть ряд данных, которые мне нужно скопировать с одного листа ивставить в другое.На другом листе есть данные о каждой 4-й ячейке, которые я не хочу перезаписывать.Таким образом, у меня в основном большой диапазон данных, и мне нужно скопировать три ячейки и вставить на другой лист под этой четвертой ячейкой, которую я описал, снова и снова, пока я не достигну конца диапазона данных.

Пример: Эти данные из листа 1 Данные листа 1

Необходимо вставить на этот лист 2 Тест листа 2

Таким образом, конечный результат имеет лист2, где «тестовые» ячейки не были перезаписаны лист 2 с вставленными данными

Спасибо!

edit

Вот код, который я сейчас использую:

'Теперь скопируйте результаты образца из wb1:

wb1.Sheets (1) .Range ("D53", wb1.Sheets (1).Range ("D53" & NumOfwells * 4 + 44)). Copy

'Now, paste to y worksheet:
wb2.Sheets("Worksheet").Range("J6").PasteSpecial

Как видите, это копируемый динамический диапазон, который может быть больше или меньше в зависимости от номера входа (NumOfwells)отсюда и расчет для диапазона.

И вы можете увидеть, где на листе выполняется копирование, то есть D53 и ниже от листа один на wb1.Затем вставляется во вторую рабочую книгу, начиная с J6.

1 Ответ

0 голосов
/ 11 октября 2018

Добро пожаловать в StackOverflow.Если вы будете публиковать вопросы в будущем, пожалуйста, включите код, который вы пробовали, и определите, где он терпит неудачу.

Из ваших вопросов и примеров вам действительно не нужно находить каждую четвертую строку, на самом деле вы простоПопытка вставить данные в местах, где нет ничего в целевой области.

Код использует один и тот же базовый цикл, чтобы показать оба случая.Следующая процедура позволяет выбрать диапазон и целевой лист.

Sub test2()
    Call CopyData(Sheet1.Range("A3:A13"), sheet2)
End Sub

Private Sub CopyData(ByVal SourceRange As Range, ByRef TargetWorksheet As Worksheet)
    Dim oIndex As Long

    For oIndex = 1 To SourceRange.Rows.Count + 1
        ' Check for blanks
        'If TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1) = "" Then
        '    TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1).Value = SourceRange.Cells(oIndex, 1).Value
        'End If

        ' Skip every 4th row
        If (oIndex - 1) Mod 4 <> 0 Then
            TargetWorksheet.Cells(SourceRange.Row + oIndex - 1, 1).Value = SourceRange.Cells(oIndex, 1).Value
        End If

    Next
End Sub
...