Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенос данных построчно с интервалом разрыва вставки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных построчно с интервалом разрыва вставки (Макросы/Sub)
Перенос данных построчно с интервалом разрыва вставки
Morrie Дата: Понедельник, 30.05.2022, 11:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Добрый день, уважаемые посетители сайта.
Сразу вынужден сказать, что данную программу делаю для себя, а именно для того, чтобы упростить свою работу, потому бОльшая часть информации в файле будет удалена (обычно там описан технологический процесс).
Цель кода: смещение строчек на определенное количество строк вниз.
Проблема моего кода: эксель файл разбит на "листы" внутри одного листа, а между листами есть интервалы (рамка документа техпроцесса), которые нужно пропускать. Мой код не работает, если я со второго листа (каждый лист занимает 49 строк экселя) хочу перенести на третий лист определенные значения. Выдает ошибку Out of range. Код с пояснениями приложу ниже:

[vba]
Код
Sub Смещение_текста3()
a = Application.InputBox("Введите на сколько перемещать:")
c = Application.InputBox("Введите начальную строку:")
b = Application.InputBox("Введите конечную строку:")
y = Application.InputBox("Введите количество интервалов:")
d = ((b - 15 * y - c) / 2) + 1 ' Формула для вычисления количества строк, которые задействуются в перемещении
i = 0 ' просто объявляю нулевую переменную для цикла Do While
e = b ' Делаю переменную, которая будет иметь начальное значение конечной строки. А от конечной строки буду убирать значения, чтобы скопировать. Копирование идет снизу вверх.
Do While i < d
If b = 62 Or b = 111 Then ' Если конечная строка равна этим значениям (а вообще не понял как установить диапазон ячеек) то переносить на 15 (копировать с предыдущего листа (который по 49 строк экселя))
b = b - 15
End If
Range(("C" & b), ("AW" & b)).Copy Destination:=Range(("C" & (e + a * 2)), ("AW" & (e + a * 2))) ' Копирование заданной ячейки и вставка через a*2 от конечной.
b = b - 2 ' вычитаю число 2 потому что записи техпроцессов идут спустя две строчки (см. файл)
e = e - 2
i = i + 1
Loop
End Sub
[/vba]

Пожалуйста, прошу, не стесняйтесь критиковать. Форум буду читать каждый час на наличие обновлений


Сообщение отредактировал Serge_007 - Понедельник, 30.05.2022, 11:38
 
Ответить
СообщениеДобрый день, уважаемые посетители сайта.
Сразу вынужден сказать, что данную программу делаю для себя, а именно для того, чтобы упростить свою работу, потому бОльшая часть информации в файле будет удалена (обычно там описан технологический процесс).
Цель кода: смещение строчек на определенное количество строк вниз.
Проблема моего кода: эксель файл разбит на "листы" внутри одного листа, а между листами есть интервалы (рамка документа техпроцесса), которые нужно пропускать. Мой код не работает, если я со второго листа (каждый лист занимает 49 строк экселя) хочу перенести на третий лист определенные значения. Выдает ошибку Out of range. Код с пояснениями приложу ниже:

[vba]
Код
Sub Смещение_текста3()
a = Application.InputBox("Введите на сколько перемещать:")
c = Application.InputBox("Введите начальную строку:")
b = Application.InputBox("Введите конечную строку:")
y = Application.InputBox("Введите количество интервалов:")
d = ((b - 15 * y - c) / 2) + 1 ' Формула для вычисления количества строк, которые задействуются в перемещении
i = 0 ' просто объявляю нулевую переменную для цикла Do While
e = b ' Делаю переменную, которая будет иметь начальное значение конечной строки. А от конечной строки буду убирать значения, чтобы скопировать. Копирование идет снизу вверх.
Do While i < d
If b = 62 Or b = 111 Then ' Если конечная строка равна этим значениям (а вообще не понял как установить диапазон ячеек) то переносить на 15 (копировать с предыдущего листа (который по 49 строк экселя))
b = b - 15
End If
Range(("C" & b), ("AW" & b)).Copy Destination:=Range(("C" & (e + a * 2)), ("AW" & (e + a * 2))) ' Копирование заданной ячейки и вставка через a*2 от конечной.
b = b - 2 ' вычитаю число 2 потому что записи техпроцессов идут спустя две строчки (см. файл)
e = e - 2
i = i + 1
Loop
End Sub
[/vba]

Пожалуйста, прошу, не стесняйтесь критиковать. Форум буду читать каждый час на наличие обновлений

Автор - Morrie
Дата добавления - 30.05.2022 в 11:01
Serge_007 Дата: Понедельник, 30.05.2022, 16:51 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2748 ±
Замечаний: ±

Excel 2016
Здравствуйте

эксель файл разбит на "листы" внутри одного листа
На страницы разбит что ли?
Пример файла приложите, по описанию мало что понятно...


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеЗдравствуйте

эксель файл разбит на "листы" внутри одного листа
На страницы разбит что ли?
Пример файла приложите, по описанию мало что понятно...

Автор - Serge_007
Дата добавления - 30.05.2022 в 16:51
Morrie Дата: Понедельник, 30.05.2022, 16:56 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Здравствуйте, Serge_007
Да, разбит на страницы. До редакции был приложен файл, но я приложу в данном сообщении.
Старался как можно понятнее описать, но задача, и правда, не из простых.
К сообщению приложен файл: VBA_TEST.xls (95.0 Kb)
 
Ответить
СообщениеЗдравствуйте, Serge_007
Да, разбит на страницы. До редакции был приложен файл, но я приложу в данном сообщении.
Старался как можно понятнее описать, но задача, и правда, не из простых.

Автор - Morrie
Дата добавления - 30.05.2022 в 16:56
msi2102 Дата: Четверг, 02.06.2022, 14:12 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Может так?
[vba]
Код
Sub Макрос1()
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy Before:=Sheets(1)
    Range("1:15,44:62,97:111,146:147").Delete Shift:=xlUp
End Sub
[/vba]
К сообщению приложен файл: 5236923.xls (121.0 Kb)
 
Ответить
СообщениеМожет так?
[vba]
Код
Sub Макрос1()
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy Before:=Sheets(1)
    Range("1:15,44:62,97:111,146:147").Delete Shift:=xlUp
End Sub
[/vba]

Автор - msi2102
Дата добавления - 02.06.2022 в 14:12
Morrie Дата: Четверг, 02.06.2022, 14:45 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Добрый день, msi2102!
Спасибо за Ваш ответ.
Код несколько не подходит, так как мне необходимы строки, которые вы удаляете в своем коде.
Единственным способом вижу лишь удаление, как это сделали вы, после чего добавление "рамки" на каждую страницу, но это весьма трудоемкая работа.
 
Ответить
СообщениеДобрый день, msi2102!
Спасибо за Ваш ответ.
Код несколько не подходит, так как мне необходимы строки, которые вы удаляете в своем коде.
Единственным способом вижу лишь удаление, как это сделали вы, после чего добавление "рамки" на каждую страницу, но это весьма трудоемкая работа.

Автор - Morrie
Дата добавления - 02.06.2022 в 14:45
msi2102 Дата: Четверг, 02.06.2022, 17:00 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
ак как мне необходимы строки, которые вы удаляете в своем коде

Я Вам предлагаю изменить подход к проблеме. Удаляемые строки можно заменить на нужные Вам, но при этом у вас уже остается нужное форматирование столбцов и строк. Просто не совсем понятно, что Вы хотите удалить, а что оставить, если Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
[vba]
Код
    Range("1:15,44:62,97:111,146:147").Delete Shift:=xlUp
[/vba]
на такую
[vba]
Код
    Range("16:47,63:96,112:145").Delete Shift:=xlUp
[/vba]
Вы можете собрать любые диапазоны в зависимости от Ваших условий
 
Ответить
Сообщение
ак как мне необходимы строки, которые вы удаляете в своем коде

Я Вам предлагаю изменить подход к проблеме. Удаляемые строки можно заменить на нужные Вам, но при этом у вас уже остается нужное форматирование столбцов и строк. Просто не совсем понятно, что Вы хотите удалить, а что оставить, если Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
[vba]
Код
    Range("1:15,44:62,97:111,146:147").Delete Shift:=xlUp
[/vba]
на такую
[vba]
Код
    Range("16:47,63:96,112:145").Delete Shift:=xlUp
[/vba]
Вы можете собрать любые диапазоны в зависимости от Ваших условий

Автор - msi2102
Дата добавления - 02.06.2022 в 17:00
Morrie Дата: Пятница, 03.06.2022, 08:48 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде

Доброе утро, msi2102.
В том и проблема, мне не нужно удалять никаких строк вовсе.
Я перемещаю информацию из одних строк в другие, которые находятся ниже. Условно у меня есть текст, который находится в 1, 2 и 3 строках. Мне нужно переместить этот текст на 3 строчки вниз. Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки.
Мой код не работает после второго интервала
 
Ответить
Сообщение
Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде

Доброе утро, msi2102.
В том и проблема, мне не нужно удалять никаких строк вовсе.
Я перемещаю информацию из одних строк в другие, которые находятся ниже. Условно у меня есть текст, который находится в 1, 2 и 3 строках. Мне нужно переместить этот текст на 3 строчки вниз. Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки.
Мой код не работает после второго интервала

Автор - Morrie
Дата добавления - 03.06.2022 в 08:48
msi2102 Дата: Пятница, 03.06.2022, 09:49 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки

Так может Вам ничего не копировать, а только вставить пустые строки, попробуйте так:
[vba]
Код
Sub Макрос1()
    'Вставка 2 строк через 3 строки 4 раза
    a = 2 'Количество вставляемых строк
    b = 3 'Через сколько строк вставить
    For n = 4 To 1 Step -1 'n - сколько раз вствалять
        Rows(b * (n - 1) + 1 & ":" & b * (n - 1) + a).Insert Shift:=xlDown
    Next
End Sub
[/vba]
В вашем примере нет конечного результата, поэтому сложно понять, что именно Вы хотите сделать. Для наглядности я добавил лист в нем 12 заполненных строк
или так:
[vba]
Код
Sub Макрос2()
    'Вставка 2 строк через 3 строки 4 раза
    a = 2 'Количество вставляемых строк
    b = 3 'Через сколько строк вставить
    c = 1 'С какой строки начинать вставку
    For n = 0 To 3 'n - сколько раз вствалять
        Rows(b * n + a * n + c & ":" & b * n + a * n + c + a - 1).Insert Shift:=xlDown
    Next
End Sub
[/vba]
К сообщению приложен файл: 6191282.xls (99.0 Kb)


Сообщение отредактировал msi2102 - Пятница, 03.06.2022, 10:42
 
Ответить
Сообщение
Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки

Так может Вам ничего не копировать, а только вставить пустые строки, попробуйте так:
[vba]
Код
Sub Макрос1()
    'Вставка 2 строк через 3 строки 4 раза
    a = 2 'Количество вставляемых строк
    b = 3 'Через сколько строк вставить
    For n = 4 To 1 Step -1 'n - сколько раз вствалять
        Rows(b * (n - 1) + 1 & ":" & b * (n - 1) + a).Insert Shift:=xlDown
    Next
End Sub
[/vba]
В вашем примере нет конечного результата, поэтому сложно понять, что именно Вы хотите сделать. Для наглядности я добавил лист в нем 12 заполненных строк
или так:
[vba]
Код
Sub Макрос2()
    'Вставка 2 строк через 3 строки 4 раза
    a = 2 'Количество вставляемых строк
    b = 3 'Через сколько строк вставить
    c = 1 'С какой строки начинать вставку
    For n = 0 To 3 'n - сколько раз вствалять
        Rows(b * n + a * n + c & ":" & b * n + a * n + c + a - 1).Insert Shift:=xlDown
    Next
End Sub
[/vba]

Автор - msi2102
Дата добавления - 03.06.2022 в 09:49
Morrie Дата: Пятница, 03.06.2022, 11:51 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Извините, msi2102, что не так ясно сказал, какой хотелось бы видеть результат действий макроса.
На листе 1 будет исходный результат, а на втором листе будет лист, который хочу получать.
Для удобства я выделил начало и конец переносимого текста цветами
К сообщению приложен файл: 0761082.xls (134.5 Kb)
 
Ответить
СообщениеИзвините, msi2102, что не так ясно сказал, какой хотелось бы видеть результат действий макроса.
На листе 1 будет исходный результат, а на втором листе будет лист, который хочу получать.
Для удобства я выделил начало и конец переносимого текста цветами

Автор - Morrie
Дата добавления - 03.06.2022 в 11:51
msi2102 Дата: Пятница, 03.06.2022, 13:09 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так:
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
m = 0
For n = 17 To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then m = m + 1: arr2(m, 1) = arr1(n, 3)
    If n = 47 Then n = 64: If n = 96 Then n = 113
    Cells(n, 3) = ""
Next
c = Application.InputBox("Введите строку Excel с которой начать вставку:")
m = 17
c = c - 17
For n = LBound(arr2) To UBound(arr2)
    Cells(m + c, 3) = arr2(n, 1): m = m + 2
    If m = 47 Then m = 64: If m = 96 Then m = 113
Next
End Sub
[/vba]
Номер строки EXCEL
К сообщению приложен файл: 6071764.xls (94.5 Kb)
 
Ответить
СообщениеПопробуйте так:
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
m = 0
For n = 17 To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then m = m + 1: arr2(m, 1) = arr1(n, 3)
    If n = 47 Then n = 64: If n = 96 Then n = 113
    Cells(n, 3) = ""
Next
c = Application.InputBox("Введите строку Excel с которой начать вставку:")
m = 17
c = c - 17
For n = LBound(arr2) To UBound(arr2)
    Cells(m + c, 3) = arr2(n, 1): m = m + 2
    If m = 47 Then m = 64: If m = 96 Then m = 113
Next
End Sub
[/vba]
Номер строки EXCEL

Автор - msi2102
Дата добавления - 03.06.2022 в 13:09
Morrie Дата: Пятница, 03.06.2022, 15:02 | Сообщение № 11
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Если со первой страницы на вторую перебрасывать, то текст удаляется, но я увидел новый подход и подчерпну у Вас знаний.
Спасибо за ответы, msi2102.
 
Ответить
СообщениеЕсли со первой страницы на вторую перебрасывать, то текст удаляется, но я увидел новый подход и подчерпну у Вас знаний.
Спасибо за ответы, msi2102.

Автор - Morrie
Дата добавления - 03.06.2022 в 15:02
msi2102 Дата: Пятница, 03.06.2022, 15:47 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Если со первой страницы на вторую перебрасывать, то текст удаляется

Да немного напутал с условиями
Попробуйте так:
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
m = 0
For n = 17 To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then
        m = m + 1
        arr2(m, 1) = arr1(n, 3)
        Cells(n, 3) = ""
    End If
    If n = 47 Then
        n = 62
    ElseIf n = 96 Then
        n = 111
    End If
Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:")
For n = LBound(arr2) To UBound(arr2)
    Cells(m, 3) = arr2(n, 1)
    If m = 47 Then
        m = 64
    ElseIf m = 96 Then
        m = 113
    Else
        m = m + 2
    End If
Next
End Sub
[/vba]
К сообщению приложен файл: 8485825.xls (117.0 Kb)
 
Ответить
Сообщение
Если со первой страницы на вторую перебрасывать, то текст удаляется

Да немного напутал с условиями
Попробуйте так:
[vba]
Код
Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
m = 0
For n = 17 To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then
        m = m + 1
        arr2(m, 1) = arr1(n, 3)
        Cells(n, 3) = ""
    End If
    If n = 47 Then
        n = 62
    ElseIf n = 96 Then
        n = 111
    End If
Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:")
For n = LBound(arr2) To UBound(arr2)
    Cells(m, 3) = arr2(n, 1)
    If m = 47 Then
        m = 64
    ElseIf m = 96 Then
        m = 113
    Else
        m = m + 2
    End If
Next
End Sub
[/vba]

Автор - msi2102
Дата добавления - 03.06.2022 в 15:47
Morrie Дата: Пятница, 03.06.2022, 16:10 | Сообщение № 13
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Да немного напутал с условиями

Что странно, у меня код берет две первых строки (всего две было написано на первой странице), потом берет две последние с третьей страницы и вставляет.
Премного Вам благодарен, буду прорабатывать код!
 
Ответить
Сообщение
Да немного напутал с условиями

Что странно, у меня код берет две первых строки (всего две было написано на первой странице), потом берет две последние с третьей страницы и вставляет.
Премного Вам благодарен, буду прорабатывать код!

Автор - Morrie
Дата добавления - 03.06.2022 в 16:10
msi2102 Дата: Пятница, 03.06.2022, 16:27 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
то странно, у меня код берет две первых строки

Может я опять не понял Ваши хотелки. Этот код собирает все записи (через строку) из диапазонов С17:С47; С64:С96; С113:С145 (без пустых ячеек) в один массив. После чего очищает эти диапазоны. И Вставляет этот массив в тот же диапазон, но со строки указанной в инпуте. Если были пустые строки, то они удаляются, т.к. в ячейках была запись: "текст или пробелы", строки с пробелами пустыми не считаются.
По крайней мере в примере работает именно так
 
Ответить
Сообщение
то странно, у меня код берет две первых строки

Может я опять не понял Ваши хотелки. Этот код собирает все записи (через строку) из диапазонов С17:С47; С64:С96; С113:С145 (без пустых ячеек) в один массив. После чего очищает эти диапазоны. И Вставляет этот массив в тот же диапазон, но со строки указанной в инпуте. Если были пустые строки, то они удаляются, т.к. в ячейках была запись: "текст или пробелы", строки с пробелами пустыми не считаются.
По крайней мере в примере работает именно так

Автор - msi2102
Дата добавления - 03.06.2022 в 16:27
Morrie Дата: Пятница, 03.06.2022, 16:57 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

msi2102, извините, что я как-то не так выразился.
Я хотел буквально все строки, которые ниже определенной строки (вводимой с клавиатуры) на первом листе переместились на N (вводимое число) ячеек.
То есть мой текст был на условной 45 строке, а я опускаю на N= 2 строк, потому получается, что мой текст с 45 строки встал на 63, а текст, который ниже тоже "упадет" ниже на N строк (условно 63 строка станет 67 строкой).
У меня просто не получается обойти вот эти "пробелы", которые занимает рамка.
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
 
Ответить
Сообщениеmsi2102, извините, что я как-то не так выразился.
Я хотел буквально все строки, которые ниже определенной строки (вводимой с клавиатуры) на первом листе переместились на N (вводимое число) ячеек.
То есть мой текст был на условной 45 строке, а я опускаю на N= 2 строк, потому получается, что мой текст с 45 строки встал на 63, а текст, который ниже тоже "упадет" ниже на N строк (условно 63 строка станет 67 строкой).
У меня просто не получается обойти вот эти "пробелы", которые занимает рамка.
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.

Автор - Morrie
Дата добавления - 03.06.2022 в 16:57
msi2102 Дата: Пятница, 03.06.2022, 17:19 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 413
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю.
Добавил инпут для начала, откуда нужно начинать сбор данных, второй инпут с какой строки вставлять. Пробуйте
[vba]
Код

Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
r = Application.InputBox("Введите строку Excel с которой начать копирование:")
If r < 17 Then r = 17
m = 0
For n = r To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then
        m = m + 1
        arr2(m, 1) = arr1(n, 3)
        Cells(n, 3) = ""
    End If
    If n = 47 Then
        n = 62
    ElseIf n = 96 Then
        n = 111
    End If
Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:")
For n = LBound(arr2) To UBound(arr2)
    Cells(m, 3) = arr2(n, 1)
    If m = 47 Then
        m = 64
    ElseIf m = 96 Then
        m = 113
    Else
        m = m + 2
    End If
Next
End Sub
[/vba]
Для начала введите в первый инпут, например 45 (это вторая заполненная строка), во второй инпут, введите строку 66 (это вторая строка на втором листе). В результате в строку 66 вставятся значения без первой строки, первая строка останется на месте
К сообщению приложен файл: 3533956.xls (119.5 Kb)
 
Ответить
Сообщение
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю.
Добавил инпут для начала, откуда нужно начинать сбор данных, второй инпут с какой строки вставлять. Пробуйте
[vba]
Код

Sub Макрос1()
Dim arr1, arr2, n As Long, m As Long, c As Long
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1)
ReDim arr2(1 To 94, 1 To 1)
r = Application.InputBox("Введите строку Excel с которой начать копирование:")
If r < 17 Then r = 17
m = 0
For n = r To UBound(arr1) Step 2
    If arr1(n, 3) <> "" Then
        m = m + 1
        arr2(m, 1) = arr1(n, 3)
        Cells(n, 3) = ""
    End If
    If n = 47 Then
        n = 62
    ElseIf n = 96 Then
        n = 111
    End If
Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:")
For n = LBound(arr2) To UBound(arr2)
    Cells(m, 3) = arr2(n, 1)
    If m = 47 Then
        m = 64
    ElseIf m = 96 Then
        m = 113
    Else
        m = m + 2
    End If
Next
End Sub
[/vba]
Для начала введите в первый инпут, например 45 (это вторая заполненная строка), во второй инпут, введите строку 66 (это вторая строка на втором листе). В результате в строку 66 вставятся значения без первой строки, первая строка останется на месте

Автор - msi2102
Дата добавления - 03.06.2022 в 17:19
Morrie Дата: Понедельник, 06.06.2022, 10:51 | Сообщение № 17
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 20% ±

Добрый день. Выходные провел с программой, разбирался, но не смог сделать под себя
Моя задача правда проще (полагаю, можно даже без массивов обойтись).
Абсолютно весь текст ниже определенной строки сместить вниз на определенное количество ячеек. То есть если у меня 20 строк текста, то все 20 строк переместить вниз на определенное количество строк вниз.
Премного благодарен Вам за помощь. Я правда очень сильно начал понимать язык.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю.
 
Ответить
СообщениеДобрый день. Выходные провел с программой, разбирался, но не смог сделать под себя
Моя задача правда проще (полагаю, можно даже без массивов обойтись).
Абсолютно весь текст ниже определенной строки сместить вниз на определенное количество ячеек. То есть если у меня 20 строк текста, то все 20 строк переместить вниз на определенное количество строк вниз.
Премного благодарен Вам за помощь. Я правда очень сильно начал понимать язык.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю.

Автор - Morrie
Дата добавления - 06.06.2022 в 10:51
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных построчно с интервалом разрыва вставки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!