Добрый день, уважаемые посетители сайта. Сразу вынужден сказать, что данную программу делаю для себя, а именно для того, чтобы упростить свою работу, потому бОльшая часть информации в файле будет удалена (обычно там описан технологический процесс). Цель кода: смещение строчек на определенное количество строк вниз. Проблема моего кода: эксель файл разбит на "листы" внутри одного листа, а между листами есть интервалы (рамка документа техпроцесса), которые нужно пропускать. Мой код не работает, если я со второго листа (каждый лист занимает 49 строк экселя) хочу перенести на третий лист определенные значения. Выдает ошибку Out of range. Код с пояснениями приложу ниже:
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 ' Делаю переменную, которая будет иметь начальное значение конечной строки. А от конечной строки буду убирать значения, чтобы скопировать. Копирование идет снизу вверх. DoWhile i < d If b = 62Or b = 111Then' Если конечная строка равна этим значениям (а вообще не понял как установить диапазон ячеек) то переносить на 15 (копировать с предыдущего листа (который по 49 строк экселя))
b = b - 15 EndIf
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 EndSub
Пожалуйста, прошу, не стесняйтесь критиковать. Форум буду читать каждый час на наличие обновлений
Добрый день, уважаемые посетители сайта. Сразу вынужден сказать, что данную программу делаю для себя, а именно для того, чтобы упростить свою работу, потому бОльшая часть информации в файле будет удалена (обычно там описан технологический процесс). Цель кода: смещение строчек на определенное количество строк вниз. Проблема моего кода: эксель файл разбит на "листы" внутри одного листа, а между листами есть интервалы (рамка документа техпроцесса), которые нужно пропускать. Мой код не работает, если я со второго листа (каждый лист занимает 49 строк экселя) хочу перенести на третий лист определенные значения. Выдает ошибку Out of range. Код с пояснениями приложу ниже:
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 ' Делаю переменную, которая будет иметь начальное значение конечной строки. А от конечной строки буду убирать значения, чтобы скопировать. Копирование идет снизу вверх. DoWhile i < d If b = 62Or b = 111Then' Если конечная строка равна этим значениям (а вообще не понял как установить диапазон ячеек) то переносить на 15 (копировать с предыдущего листа (который по 49 строк экселя))
b = b - 15 EndIf
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 EndSub
Пожалуйста, прошу, не стесняйтесь критиковать. Форум буду читать каждый час на наличие обновленийMorrie
Сообщение отредактировал Serge_007 - Понедельник, 30.05.2022, 11:38
Здравствуйте, Serge_007 Да, разбит на страницы. До редакции был приложен файл, но я приложу в данном сообщении. Старался как можно понятнее описать, но задача, и правда, не из простых.
Здравствуйте, Serge_007 Да, разбит на страницы. До редакции был приложен файл, но я приложу в данном сообщении. Старался как можно понятнее описать, но задача, и правда, не из простых.Morrie
Добрый день, msi2102! Спасибо за Ваш ответ. Код несколько не подходит, так как мне необходимы строки, которые вы удаляете в своем коде. Единственным способом вижу лишь удаление, как это сделали вы, после чего добавление "рамки" на каждую страницу, но это весьма трудоемкая работа.
Добрый день, msi2102! Спасибо за Ваш ответ. Код несколько не подходит, так как мне необходимы строки, которые вы удаляете в своем коде. Единственным способом вижу лишь удаление, как это сделали вы, после чего добавление "рамки" на каждую страницу, но это весьма трудоемкая работа.Morrie
ак как мне необходимы строки, которые вы удаляете в своем коде
Я Вам предлагаю изменить подход к проблеме. Удаляемые строки можно заменить на нужные Вам, но при этом у вас уже остается нужное форматирование столбцов и строк. Просто не совсем понятно, что Вы хотите удалить, а что оставить, если Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
ак как мне необходимы строки, которые вы удаляете в своем коде
Я Вам предлагаю изменить подход к проблеме. Удаляемые строки можно заменить на нужные Вам, но при этом у вас уже остается нужное форматирование столбцов и строк. Просто не совсем понятно, что Вы хотите удалить, а что оставить, если Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
Доброе утро, msi2102. В том и проблема, мне не нужно удалять никаких строк вовсе. Я перемещаю информацию из одних строк в другие, которые находятся ниже. Условно у меня есть текст, который находится в 1, 2 и 3 строках. Мне нужно переместить этот текст на 3 строчки вниз. Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки. Мой код не работает после второго интервала
Вы удаляете данные а оставляете рамки, то нужно заменить строку в коде
Доброе утро, msi2102. В том и проблема, мне не нужно удалять никаких строк вовсе. Я перемещаю информацию из одних строк в другие, которые находятся ниже. Условно у меня есть текст, который находится в 1, 2 и 3 строках. Мне нужно переместить этот текст на 3 строчки вниз. Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки. Мой код не работает после второго интервалаMorrie
Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки
Так может Вам ничего не копировать, а только вставить пустые строки, попробуйте так:
Sub Макрос1() 'Вставка 2 строк через 3 строки 4 раза
a = 2'Количество вставляемых строк
b = 3'Через сколько строк вставить For n = 4To1Step -1'n - сколько раз вствалять
Rows(b * (n - 1) + 1 & ":" & b * (n - 1) + a).Insert Shift:=xlDown Next EndSub
В вашем примере нет конечного результата, поэтому сложно понять, что именно Вы хотите сделать. Для наглядности я добавил лист в нем 12 заполненных строк или так:
Sub Макрос2() 'Вставка 2 строк через 3 строки 4 раза
a = 2'Количество вставляемых строк
b = 3'Через сколько строк вставить
c = 1'С какой строки начинать вставку For n = 0To3'n - сколько раз вствалять
Rows(b * n + a * n + c & ":" & b * n + a * n + c + a - 1).Insert Shift:=xlDown Next EndSub
Итого: в 1, 2 и 3 строках ничего не будет, а в 4,5 и 6 будут те самые строки
Так может Вам ничего не копировать, а только вставить пустые строки, попробуйте так:
Sub Макрос1() 'Вставка 2 строк через 3 строки 4 раза
a = 2'Количество вставляемых строк
b = 3'Через сколько строк вставить For n = 4To1Step -1'n - сколько раз вствалять
Rows(b * (n - 1) + 1 & ":" & b * (n - 1) + a).Insert Shift:=xlDown Next EndSub
В вашем примере нет конечного результата, поэтому сложно понять, что именно Вы хотите сделать. Для наглядности я добавил лист в нем 12 заполненных строк или так:
Sub Макрос2() 'Вставка 2 строк через 3 строки 4 раза
a = 2'Количество вставляемых строк
b = 3'Через сколько строк вставить
c = 1'С какой строки начинать вставку For n = 0To3'n - сколько раз вствалять
Rows(b * n + a * n + c & ":" & b * n + a * n + c + a - 1).Insert Shift:=xlDown Next EndSub
Извините, msi2102, что не так ясно сказал, какой хотелось бы видеть результат действий макроса. На листе 1 будет исходный результат, а на втором листе будет лист, который хочу получать. Для удобства я выделил начало и конец переносимого текста цветами
Извините, msi2102, что не так ясно сказал, какой хотелось бы видеть результат действий макроса. На листе 1 будет исходный результат, а на втором листе будет лист, который хочу получать. Для удобства я выделил начало и конец переносимого текста цветамиMorrie
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
m = 0 For n = 17ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then m = m + 1: arr2(m, 1) = arr1(n, 3) If n = 47Then n = 64: If n = 96Then n = 113
Cells(n, 3) = "" Next
c = Application.InputBox("Введите строку Excel с которой начать вставку:")
m = 17
c = c - 17 For n = LBound(arr2) ToUBound(arr2)
Cells(m + c, 3) = arr2(n, 1): m = m + 2 If m = 47Then m = 64: If m = 96Then m = 113 Next EndSub
Номер строки EXCEL
Попробуйте так:
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
m = 0 For n = 17ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then m = m + 1: arr2(m, 1) = arr1(n, 3) If n = 47Then n = 64: If n = 96Then n = 113
Cells(n, 3) = "" Next
c = Application.InputBox("Введите строку Excel с которой начать вставку:")
m = 17
c = c - 17 For n = LBound(arr2) ToUBound(arr2)
Cells(m + c, 3) = arr2(n, 1): m = m + 2 If m = 47Then m = 64: If m = 96Then m = 113 Next EndSub
Если со первой страницы на вторую перебрасывать, то текст удаляется, но я увидел новый подход и подчерпну у Вас знаний. Спасибо за ответы, msi2102.
Если со первой страницы на вторую перебрасывать, то текст удаляется, но я увидел новый подход и подчерпну у Вас знаний. Спасибо за ответы, msi2102.Morrie
Если со первой страницы на вторую перебрасывать, то текст удаляется
Да немного напутал с условиями Попробуйте так:
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
m = 0 For n = 17ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then
m = m + 1
arr2(m, 1) = arr1(n, 3)
Cells(n, 3) = "" EndIf If n = 47Then
n = 62 ElseIf n = 96Then
n = 111 EndIf Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:") For n = LBound(arr2) ToUBound(arr2)
Cells(m, 3) = arr2(n, 1) If m = 47Then
m = 64 ElseIf m = 96Then
m = 113 Else
m = m + 2 EndIf Next EndSub
Если со первой страницы на вторую перебрасывать, то текст удаляется
Да немного напутал с условиями Попробуйте так:
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
m = 0 For n = 17ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then
m = m + 1
arr2(m, 1) = arr1(n, 3)
Cells(n, 3) = "" EndIf If n = 47Then
n = 62 ElseIf n = 96Then
n = 111 EndIf Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:") For n = LBound(arr2) ToUBound(arr2)
Cells(m, 3) = arr2(n, 1) If m = 47Then
m = 64 ElseIf m = 96Then
m = 113 Else
m = m + 2 EndIf Next EndSub
Что странно, у меня код берет две первых строки (всего две было написано на первой странице), потом берет две последние с третьей страницы и вставляет. Премного Вам благодарен, буду прорабатывать код!
Что странно, у меня код берет две первых строки (всего две было написано на первой странице), потом берет две последние с третьей страницы и вставляет. Премного Вам благодарен, буду прорабатывать код!Morrie
Может я опять не понял Ваши хотелки. Этот код собирает все записи (через строку) из диапазонов С17:С47; С64:С96; С113:С145 (без пустых ячеек) в один массив. После чего очищает эти диапазоны. И Вставляет этот массив в тот же диапазон, но со строки указанной в инпуте. Если были пустые строки, то они удаляются, т.к. в ячейках была запись: "текст или пробелы", строки с пробелами пустыми не считаются. По крайней мере в примере работает именно так
Может я опять не понял Ваши хотелки. Этот код собирает все записи (через строку) из диапазонов С17:С47; С64:С96; С113:С145 (без пустых ячеек) в один массив. После чего очищает эти диапазоны. И Вставляет этот массив в тот же диапазон, но со строки указанной в инпуте. Если были пустые строки, то они удаляются, т.к. в ячейках была запись: "текст или пробелы", строки с пробелами пустыми не считаются. По крайней мере в примере работает именно такmsi2102
msi2102, извините, что я как-то не так выразился. Я хотел буквально все строки, которые ниже определенной строки (вводимой с клавиатуры) на первом листе переместились на N (вводимое число) ячеек. То есть мой текст был на условной 45 строке, а я опускаю на N= 2 строк, потому получается, что мой текст с 45 строки встал на 63, а текст, который ниже тоже "упадет" ниже на N строк (условно 63 строка станет 67 строкой). У меня просто не получается обойти вот эти "пробелы", которые занимает рамка. Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
msi2102, извините, что я как-то не так выразился. Я хотел буквально все строки, которые ниже определенной строки (вводимой с клавиатуры) на первом листе переместились на N (вводимое число) ячеек. То есть мой текст был на условной 45 строке, а я опускаю на N= 2 строк, потому получается, что мой текст с 45 строки встал на 63, а текст, который ниже тоже "упадет" ниже на N строк (условно 63 строка станет 67 строкой). У меня просто не получается обойти вот эти "пробелы", которые занимает рамка. Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.Morrie
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю. Добавил инпут для начала, откуда нужно начинать сбор данных, второй инпут с какой строки вставлять. Пробуйте
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
r = Application.InputBox("Введите строку Excel с которой начать копирование:") If r < 17Then r = 17
m = 0 For n = r ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then
m = m + 1
arr2(m, 1) = arr1(n, 3)
Cells(n, 3) = "" EndIf If n = 47Then
n = 62 ElseIf n = 96Then
n = 111 EndIf Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:") For n = LBound(arr2) ToUBound(arr2)
Cells(m, 3) = arr2(n, 1) If m = 47Then
m = 64 ElseIf m = 96Then
m = 113 Else
m = m + 2 EndIf Next EndSub
Для начала введите в первый инпут, например 45 (это вторая заполненная строка), во второй инпут, введите строку 66 (это вторая строка на втором листе). В результате в строку 66 вставятся значения без первой строки, первая строка останется на месте
Искренне прошу не ругаться. В выходные постараюсь сделать и прислать сюда.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю. Добавил инпут для начала, откуда нужно начинать сбор данных, второй инпут с какой строки вставлять. Пробуйте
Sub Макрос1() Dim arr1, arr2, n AsLong, m AsLong, c AsLong
arr1 = Range("A1:AW" & Cells(Rows.Count, 2).End(xlUp).Row + 1) ReDim arr2(1To94, 1To1)
r = Application.InputBox("Введите строку Excel с которой начать копирование:") If r < 17Then r = 17
m = 0 For n = r ToUBound(arr1) Step2 If arr1(n, 3) <> ""Then
m = m + 1
arr2(m, 1) = arr1(n, 3)
Cells(n, 3) = "" EndIf If n = 47Then
n = 62 ElseIf n = 96Then
n = 111 EndIf Next
m = Application.InputBox("Введите строку Excel с которой начать вставку:") For n = LBound(arr2) ToUBound(arr2)
Cells(m, 3) = arr2(n, 1) If m = 47Then
m = 64 ElseIf m = 96Then
m = 113 Else
m = m + 2 EndIf Next EndSub
Для начала введите в первый инпут, например 45 (это вторая заполненная строка), во второй инпут, введите строку 66 (это вторая строка на втором листе). В результате в строку 66 вставятся значения без первой строки, первая строка останется на местеmsi2102
Добрый день. Выходные провел с программой, разбирался, но не смог сделать под себя Моя задача правда проще (полагаю, можно даже без массивов обойтись). Абсолютно весь текст ниже определенной строки сместить вниз на определенное количество ячеек. То есть если у меня 20 строк текста, то все 20 строк переместить вниз на определенное количество строк вниз. Премного благодарен Вам за помощь. Я правда очень сильно начал понимать язык.
я и не ругаюсь, это Вам нужно, а не мне, пока есть возможность помогаю.
Добрый день. Выходные провел с программой, разбирался, но не смог сделать под себя Моя задача правда проще (полагаю, можно даже без массивов обойтись). Абсолютно весь текст ниже определенной строки сместить вниз на определенное количество ячеек. То есть если у меня 20 строк текста, то все 20 строк переместить вниз на определенное количество строк вниз. Премного благодарен Вам за помощь. Я правда очень сильно начал понимать язык.
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
