Макрос в excel для переноса в ячейки

 

7even

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

Из программы в которой приходится работать некорректно выгружается табличка. Данные которые должны быть в одной строки разбросаны в 2 строки. Нужен макрос который собирет разбросанное в 2 строки в 1 строку.
Прикрепил образец. Слева табличка как выгружается изначально, а с права, то как должно получится после использования макроса.

Такое возможно?

 

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#2

13.07.2015 21:05:06

Код
Sub jjj()
    [A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End Sub

Прикрепленные файлы

  • образец.xlsb (16.99 КБ)

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

7even

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

JayBhagavan,
Спасибо. то, что надо!

 

7even

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

JayBhagavan, к сожалению, с таблицей в 20000 строк макрос не работает. ничего не происходит. Или же удаляется вся таблица. возможно ли это поправить?

Изменено: SevenZZ14.07.2015 10:51:27

 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#5

14.07.2015 11:49:45

JayBhagavan, если данные в какой-то из ячеек будут отсутствовать, получится нехорошее смещение (я понял так: не удалять пустоты, а объединить две строки в одну).

Код
Sub UniteLines()
Dim ArrData
Dim i As Long, k As Long
    ArrData = ActiveSheet.UsedRange.Value

    For i = 1 To UBound(ArrData) Step 2
        k = k + 1
        ArrData(k, 1) = ArrData(i, 1)
        ArrData(k, 2) = ArrData(i + 1, 2)
        ArrData(k, 3) = ArrData(i, 3)
        ArrData(k, 4) = ArrData(i + 1, 4)
        ArrData(k, 5) = ArrData(i + 1, 5)
    Next i
    
'    ActiveSheet.UsedRange.Delete
'    Cells(1, 1).Resize(k, 5).Value = ArrData
    Cells(1, 9).Resize(k, 5).Value = ArrData
End Sub

Код сработает на активном листе. Обработка всего массива данных, т.е. если на листе есть данные, которые изменять  не нужно, необходимо подправить код
Если данные нужно заменить на месте — раскомментировать строки 15 и 16, закомментировать строку 17
(удалить только данные — строку 15 заменить на ActiveSheet.UsedRange.ClearContents)

Аккуратнее с кнопкой! Можно и несколько раз нажать, но строк станет меньше :)

Прикрепленные файлы

  • объединить.xlsm (15.46 КБ)

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Попробуйте такой вариант. Если на 20 000 строк будет медленно, то можно сделать на массивах.

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

А вот и вариант на массивах.

 

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

vikttur, каков пример — таков ответ.

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

SevenZZ

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

завтра на работе опробую все предложенные варианты. спасибо всем кто отозвался помочь.
Единствееное заметил, что макрос(ы) работает только с 5 колонками. Можно ли сделать, чтобы работал с неограниченным числом колонок, и, чтобы корректная таблица создавалась не справа, а на 2 листе или чтобы сразу в нее преобразовывалась?

Изменено: SevenZZ14.07.2015 22:25:07

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#10

14.07.2015 22:34:57

Цитата
SevenZZ написал:
чтобы корректная таблица создавалась не справа, а на 2 листе или чтобы сразу в нее преобразовывалась

Так КАК всё же нужно?

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

 

SevenZZ

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

#12

15.07.2015 07:13:24

Цитата
Юрий М написал: Так КАК всё же нужно?

не принципиально как.

Цитата
Юрий М написал: Вот на второй лист.

спасибо сегодня опробую. Только вот если в таблице 7 колонок, а не 5, то 2 последние на добавляются на 2 лист.
В моих рабочих таблицах всегда разное кол-во столбцов и очень большое ко-во срок. Или может мне в макросе нужно в ручную что-то редактировать, чтобы он работал например с 7 колонками, или когда мне надо с 15 и т.д.?

 

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

Файл из сообщения 11: если перенести значение С9 в С10, последняя строка игнорируется.
Вопрос больше к автору темы, а не к автору макроса.

 

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#14

15.07.2015 13:16:40

Цитата
SevenZZ написал:
Только вот если в таблице 7 колонок, а не 5, то 2 последние на добавляются на 2 лист.

Мой недочёт… Исправил файл — скачайте его заново. Количество столбцов определяется автоматически.

 

SevenZZ

Пользователь

Сообщений: 85
Регистрация: 09.02.2015

#15

15.07.2015 22:22:40

Цитата
Юрий М написал: Количество столбцов определяется автоматически.

Спасибо, всё работает как надо.
всем кто отозвался, спасибо, извиняюсь, если изъяснялся не ясно.

Разделение текста на части и перенос в другие ячейки

giovanni

Дата: Вторник, 17.05.2016, 11:16 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

Здравствуйте!
Возможно, для знатоков VBA данный вопрос будет выглядеть довольно просто и забавно, но для малоопытного пользователя VBA — вопрос видится очень сложным :)

Ситуация примерно такова: в экселе есть ячейка, в которой записан образно такого вида текст: А.10,Бв.25
В основном, тескт записан в таком виде. Однако, могут встречать ячейки, в который текст имеет такой вид: 10,Бв25 (то есть, без первой буквы). Буквы Бв.25 (цифры всегда разные, 25 — выбрана в качестве примера), присутствуют в ячейке всегда.
Подскажите, пожалуйста, возможно ли макросом разделить данный текст так, чтобы удалялись буквы «А.» и «Бв.», а цифры, следующие за буквами, переносились в разные указанные ячейки, то есть, удаляется буква «А.», цифра 10 переносится в одну ячейку, удаляется слово «Бв.», а 25 переносится в другую ячейку?

Все, что пришло на ум — это проверять ячейку справа налево на наличие слова Бв., если слово в ячейке есть, то удалять его, а все, что правее от «Бв.», переносить в соседнюю ячейку. После этой процедуры опять проверять ячейку на наличие буквы «А.» и есть такая буква есть, то удалить ее и все, что правее от нее, переносить в другую соседнюю ячейку.
Наверняка это далеко не самое оптимальное решение)
Если не сложно, помогите, пожалуйста, в решении данной задачи.

Спасибо!
[moder]Покажите файл. И приведите несколько примеров, как может выглядеть исходный текст.[/moder]

Исходный текст может быть соедующего вида:
А.5,Бв.12
А.108,Бв.3
А.218,Бв.140
Если есть слово «Бв.», то в ячейке точно за этим словом следует число. Чисто может быть от 1 до 999.

Сообщение отредактировал giovanniВторник, 17.05.2016, 12:40

 

Ответить

китин

Дата: Вторник, 17.05.2016, 11:36 |
Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 6973


Репутация:

1063

±

Замечаний:
0% ±


Excel 2007;2010;2016

а может формулами обойдемся? :D

Код

=ЕСЛИОШИБКА(ПСТР(A1;ПОИСК(«А.»;A1)+2;2);ЛЕВБ(A1;2))


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

 

Ответить

giovanni

Дата: Вторник, 17.05.2016, 12:46 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

а может формулами обойдемся?

Совсем неважно макрос или формула :-) Подскажите, возможно ли формулу внедрить в макрос? Т.к. указанная задача — это часть более крупного макроса.

В файлике все работает отлично :-) Но есть установить в ячейке более крупное чисто (не 10, а 100), то в итоге выдается ошибка(

Файла с примером как такового нет.
В принципе, задача только разделить указанный выше текст.

Извиняюсь за неправильное цитирование, не сорентировался)

[moder]Читайте Правила форума.
Запрещено: излишнее цитирование, несколько разных вопросов в одной теме. Необходим Ваш файл-пример, как уже было указано в комментарии модератора выше.
Исправляйте этот пост.[/moder]

Сообщение отредактировал giovanniВторник, 17.05.2016, 14:21

 

Ответить

китин

Дата: Вторник, 17.05.2016, 12:54 |
Сообщение № 4

Группа: Модераторы

Ранг: Экселист

Сообщений: 6973


Репутация:

1063

±

Замечаний:
0% ±


Excel 2007;2010;2016

в вашей сплошной цитате я не вижу вашего ответа.


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

 

Ответить

sv2014

Дата: Вторник, 17.05.2016, 17:53 |
Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226


Репутация:

61

±

Замечаний:
0% ±


Excel 2013

giovanni, добрый вечер,вариант функций uuu1 и uuu2

[vba]

Код

Function uuu1%(t$)
With CreateObject(«VBScript.RegExp»): .Pattern = «d+»
    uuu1 = .Execute(t)(0)
End With
End Function

[/vba]

F[vba]

Код

unction uuu2%(t$)
With CreateObject(«VBScript.RegExp»): .Pattern = «d+»: .Global = True
    uuu2 = .Execute(t)(1)
End With
End Function

[/vba]

 

Ответить

sv2014

Дата: Вторник, 17.05.2016, 18:07 |
Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226


Репутация:

61

±

Замечаний:
0% ±


Excel 2013

giovanni, добавил еще функции uuu3 и uuu4 в столбцах E и F соответственно

[vba]

Код

Function uuu3%(t$)
With CreateObject(«VBScript.RegExp»): .Pattern = «(?:А.)?(d+)»
    uuu3 = .Execute(t)(0).Submatches(0)
End With
End Function

[/vba]

[vba]

Код

Function uuu4%(t$)
With CreateObject(«VBScript.RegExp»): .Pattern = «Бв.(d+)»
    uuu4 = .Execute(t)(0).Submatches(0)
End With
End Function

[/vba]

К сообщению приложен файл:

8261232.xls
(32.0 Kb)

 

Ответить

giovanni

Дата: Среда, 18.05.2016, 00:18 |
Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

giovanni, добавил еще функции uuu3 и uuu4 в столбцах E и F соответственно

Огромное спасибо! Работает отлично))
Уровень знаний в VBA не позволил ничего понять из указанного кода, но работает прекрасно!
Был бы очень признателен, если по возможности Вы бы расписали что означают различные значения
в коде функции, очень интересно понять)

Подскажите, пожалуйста, возможно ли внести некоторые изменения в код, чтобы происходило следующее:
в ячейке, перед указанным ранее в примере текстом А.5,Бв.12, практически всегда будет присутствовать текст — одно-два слова
(например, Абвгдежз А.5,Бв.12)
Возможно ли сделать так, чтобы, как в Вашем примере, цифры 5 и 12 переносились в отдельные ячейки, данные цифры удалялись бы из исходной ячейки
и слово Абвгдежз также удалялось из исходной ячейки и переносилось в еще одну отдельную ячейку.
Если сказать на примере, то примерно так: в исходной ячейке текст «Абвгдежз А.5,Бв.12», а после исполнения макроса — «Абвгдежз» в отдельной ячейке, цифра «5» в отдельной ячейке и цифра «12» также в отдельной ячейке.

Спасибо за помощь еще раз!)
[moder]Вот, как мы все с нетерпением и ожидали, начинается комедия «А у меня в файле всё не так». Вам уже 2 раза сказали про файл с вариантами заполнения. Что не понятно?

Сообщение отредактировал _Boroda_Среда, 18.05.2016, 10:18

 

Ответить

sv2014

Дата: Среда, 18.05.2016, 10:28 |
Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226


Репутация:

61

±

Замечаний:
0% ±


Excel 2013

giovanni, добрый день,протестируйте макрос,кнопки test,повтор

[vba]

Код

Sub test()
   Dim z(), z1(), i&, t, t1, t2, t3
   z = Range(«A1:A» & Range(«A» & Rows.Count).End(xlUp).Row).Value
   ReDim z1(1 To UBound(z), 1 To 3)
With CreateObject(«VBScript.RegExp»): .Pattern = «([а-яё]+) А.(d+),Бв.(d+)»: .IgnoreCase = True: .Global = True
  For i = 1 To UBound(z): t = z(i, 1)
    t1 = .Execute(t)(0).Submatches(0): t2 = .Execute(t)(0).Submatches(1): t3 = .Execute(t)(0).Submatches(2)
    z(i, 1) = Replace(Replace(Replace(t, t1, «»), t2, «»), t3, «»)
    z1(i, 1) = t1: z1(i, 2) = t2: z1(i, 3) = t3
  Next
End With
  Range(«A1»).Resize(UBound(z), 1).Value = z
  Range(«B1»).Resize(UBound(z1), 3).Value = z1
End Sub

[/vba]

Сообщение отредактировал sv2014Среда, 18.05.2016, 10:38

 

Ответить

giovanni

Дата: Среда, 18.05.2016, 21:38 |
Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

giovanni, добрый день,протестируйте макрос,кнопки test,повтор

С исходным текстом, указанным Вами в примере, работает отлично, но когда подставляю другой текст, начинает ругаться :-(

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

Огромное спасибо за помощь.

Сообщение отредактировал giovanniСреда, 18.05.2016, 21:39

 

Ответить

sv2014

Дата: Среда, 18.05.2016, 23:09 |
Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226


Репутация:

61

±

Замечаний:
0% ±


Excel 2013

giovanni, добрый вечер,для Вашего нового файл-примера,вариант макроса кнопки test1 и повтор

[vba]

Код

Sub test1()
   Dim z(), z1(), i&, t, t1, t2, t3
   z = Range(«A3:A» & Range(«A» & Rows.Count).End(xlUp).Row).Value
   ReDim z1(1 To UBound(z), 1 To 3)
With CreateObject(«VBScript.RegExp»)
  For i = 1 To UBound(z): t = z(i, 1)
  .Pattern = «[а-яё]+»: .IgnoreCase = True
    t1 = .Execute(t)(0)
    .Pattern = «d+»: .Global = True
   If .Execute(t).Count > 1 Then t2 = .Execute(t)(.Execute(t).Count — 2): t3 = .Execute(t)(.Execute(t).Count — 1) Else t2 = .Execute(t)(.Execute(t).Count — 1): t3 = «»
    z(i, 1) = Replace(Replace(Replace(t, t1, «»), t2, «»), t3, «»)
    z1(i, 1) = t1: z1(i, 2) = t2: z1(i, 3) = t3
  Next
End With
  Range(«A3»).Resize(UBound(z), 1).Value = z
  Range(«B3»).Resize(UBound(z1), 3).Value = z1
End Sub

[/vba]

 

Ответить

giovanni

Дата: Воскресенье, 22.05.2016, 17:48 |
Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

giovanni, добрый вечер,для Вашего нового файл-примера,вариант макроса кнопки test1 и повтор

Здравствуйте!

Макрос работает отлично, именно то, что нужно!
Огромное спасибо за помощь!

Если можно, помогите, пожалуйста в одном моменте, связанном с работой данного макроса.
К примеру, если текст «Абвгдежз» цельный, то все работает отлично. Но, к примеру, если в
слове «Абвгдежз» присутствует точка («Абвг.дежз»), то макрос переносит только часть слова,
а именно ту часть, которая до точки («Абвг»).
Возможно ли в рамках данного макроса сделать так, чтобы слово «Абвгдежз» переносилось
полностью, вне зависимости от наличия в слове точки?

Спасибо!

 

Ответить

sv2014

Дата: Воскресенье, 22.05.2016, 19:17 |
Сообщение № 12

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 226


Репутация:

61

±

Замечаний:
0% ±


Excel 2013

giovanni, добрый вечер,поменяйте шаблон(Pattern) в макросе,например,скопировав, на такой вариант

.[vba]

[/vba]

и это будет ответ на Ваш вопрос в последнем сообщении.

 

Ответить

giovanni

Дата: Среда, 25.05.2016, 18:09 |
Сообщение № 13

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

giovanni, добрый вечер,поменяйте шаблон(Pattern) в макросе,например,скопировав, на такой вариант

Здравствуйте!

Внес изменения, как Вы сказали, все работает отлично! Огромное спасибо!)

Если не сложно, подскажите, пожалуйста, по одному моменту в данном макросе.
Думал разберусь сам, т.к. чуток дружу с VBA, но не получается)

В данном макросе обрабатывается исходный текст, находящийся в начиная с ячейки «А3» и далее по всему столбцу «А».
Обработанный макросом текст вставляется в соседние ячейки, правее от исходного текста.
Можно ли внести в макрос изменения, чтобы его можно было применить к исходному тексту, находящегося в любой другой ячейке?
К примеру, если исходный текст будет находиться не в столбце «А», а, например, в ячейке «N2».
Вижу в коде макроса строку:

Код

z = Range(«A3:A» & Range(«A» & Rows.Count).End(xlUp).Row).Value

когда изменяю адрес ячейки «А3» на другой, текст находящийся в указанной ячейке не обрабатывается макросом.
Наверняка что-то делаю не так)

Спасибо!

Сообщение отредактировал giovanniСреда, 25.05.2016, 19:51

 

Ответить

Kuzmich

Дата: Среда, 25.05.2016, 20:53 |
Сообщение № 14

Группа: Проверенные

Ранг: Ветеран

Сообщений: 707


Репутация:

154

±

Замечаний:
0% ±


Excel 2003

[vba]

Код

z = Range(«N2:N» & Range(«N» & Rows.Count).End(xlUp).Row).Value

[/vba]
и , возможно надо изменить диапазон выгрузки
[moder]Не забывайте оформлять правильно код. Поправил за Вас[/moder]

Сообщение отредактировал SLAVICKСреда, 25.05.2016, 21:39

 

Ответить

giovanni

Дата: Среда, 25.05.2016, 21:37 |
Сообщение № 15

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

z = Range(«N2:N» & Range(«N» & Rows.Count).End(xlUp).Row).Value
и , возможно надо изменить диапазон выгрузки

Вы правы, изменение данной строки работает: [vba]

Код

z = Range(«N2:N» & Range(«N» & Rows.Count).End(xlUp).Row).Value

[/vba]
Однако, выгрузка результатов работы макроса происходит в те же ячейки, что и раньше.
Возможно ли изменить диапазон выгрузки?
[moder]для оформления кода — используйте тег #[/moder]

Сообщение отредактировал SLAVICKСреда, 25.05.2016, 21:42

 

Ответить

Kuzmich

Дата: Среда, 25.05.2016, 21:45 |
Сообщение № 16

Группа: Проверенные

Ранг: Ветеран

Сообщений: 707


Репутация:

154

±

Замечаний:
0% ±


Excel 2003

Диапазон выгрузки определяется строками
[vba]

Код

Range(«A1»).Resize(UBound(z), 1).Value = z
Range(«B1»).Resize(UBound(z1), 3).Value = z1

[/vba]
Вместо A1 и B1 поставьте свои N и O

 

Ответить

giovanni

Дата: Четверг, 26.05.2016, 00:30 |
Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

Диапазон выгрузки определяется строками

Огромное спасибо! Работает!)

 

Ответить

giovanni

Дата: Суббота, 28.05.2016, 16:26 |
Сообщение № 18

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

Доброго дня!

Подскажите, пожалуйста, как сделать так, чтобы данный макрос работал только для содержимого одной ячейки, к примеру — «А2»?

Пытался внести изменения в строку [vba]

Код

z = Range(«A3:A» & Range(«A» & Rows.Count).End(xlUp).Row).Value

[/vba] оставив в тексте только [vba][/vba] , но в этом случае VBA ругается на ошибку.

Спасибо!

 

Ответить

Kuzmich

Дата: Суббота, 28.05.2016, 17:24 |
Сообщение № 19

Группа: Проверенные

Ранг: Ветеран

Сообщений: 707


Репутация:

154

±

Замечаний:
0% ±


Excel 2003

Цитата

макрос работал только для содержимого одной ячейки

Воспользуйтесь UDF, которые вам представил sv2014 в сообщениях 5 и 6

 

Ответить

giovanni

Дата: Суббота, 28.05.2016, 20:14 |
Сообщение № 20

Группа: Пользователи

Ранг: Новичок

Сообщений: 37


Репутация:

0

±

Замечаний:
20% ±


Excel 2010

Воспользуйтесь UDF, которые вам представил sv2014 в сообщениях 5 и 6

Указанный Вами UDF работают немного не так, как нужно. В то же время макрос, указанный в сообщении №10 форматирует текст именно так, как нужно:

[vba]

Код

Sub test1()
Dim z(), z1(), i&, t, t1, t2, t3
z = Range(«A3:A» & Range(«A» & Rows.Count).End(xlUp).Row).Value
ReDim z1(1 To UBound(z), 1 To 3)
With CreateObject(«VBScript.RegExp»)
For i = 1 To UBound(z): t = z(i, 1)
.Pattern = «[а-яё]+»: .IgnoreCase = True
    t1 = .Execute(t)(0)
    .Pattern = «d+»: .Global = True
If .Execute(t).Count > 1 Then t2 = .Execute(t)(.Execute(t).Count — 2): t3 = .Execute(t)(.Execute(t).Count — 1) Else t2 = .Execute(t)(.Execute(t).Count — 1): t3 = «»
    z(i, 1) = Replace(Replace(Replace(t, t1, «»), t2, «»), t3, «»)
    z1(i, 1) = t1: z1(i, 2) = t2: z1(i, 3) = t3
Next
End With
Range(«A3»).Resize(UBound(z), 1).Value = z
Range(«B3»).Resize(UBound(z1), 3).Value = z1
End Sub

[/vba]

Единственный момент с данным макросом — это то, что если применить его к количеству строк меньшему, чем указано в файле (в файле примера 5 строк),
то VBA выдает ошибку «Type missmatch».
Если заставить данный макрос работать только с одной указанной ячейкой, то это будет на 100% то, что нужно)
По мере своих знаний в VBA пытался изменить диапазон работы макроса, но не получается.

 

Ответить

0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

1

Перенос значений из одной ячейки в другую по условию

29.05.2019, 12:46. Показов 7737. Ответов 28


Студворк — интернет-сервис помощи студентам

Добрый день. Ситуация такая: есть таблица в один столбец, в котором стоят текстовые значения.

Выглядит он так:

ООО Ромашка
+123456789
Улица Луговая (текст серый)

Бьюсь над макросом. Алгоритм такой: проверить, если текст в ячейке жирный, переносить в столбец 2 (рядом с «ООО Ромашка», то есть на строчку вверх относительно начальной строчки), если нет, то проверить, если текст в ячейке не черный, переносить в столбец 3 (рядом с номером телефона, то есть на две строчки вверх относительно начальной строчки). И выбрать после этого следующую ячейку в том же столбце.

Без цикла, то есть одно нажатие — одна проверка.
Помогите, пожалуйста. Вроде и простая задача, но я уже всю голову сломала.



0



ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 13:09

2

Visual Basic
1
2
3
r = Selection.row
c = Selection.Columns
If  Selection.Font.Bond = True then Selection.copy Cells(r-1, c)

Как-то так? А лучше скиньте файл с Вашим макросом

Добавлено через 3 минуты
По тойже аналогии с цветом. К примеру:

Visual Basic
1
Selection.Font.ThemeColor = xlThemeColorDark1

Добавлено через 1 минуту
а, забыл очистить

Visual Basic
1
Cells (r, c).ClearContents



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 13:57

 [ТС]

3

Говорит, Type Mismatch на вот эту строчку: Cells(r, c).ClearContents
Если без нее, отрабатывает как котик.



0



ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:12

4

Type Mismatch — несоответствие типов. Проверьте какое значение принимают r и c. Скорее всего проблема здесь:

Visual Basic
1
c = Selection.Columns

замените на

Visual Basic
1
c = Selection.Column

Добавлено через 2 минуты
Это моя опечатка, сории



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 14:18

 [ТС]

5

Теперь Unable to set the Copy property of the Range class на строчку Selection.Copy = Cells(r — 1, c + 1)

(я там подправила по логике, потому что колонка тоже меняется на соседние)



0



370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:20

6

Selection.Copy = Cells(r — 1, c + 1)
Равно уберите

Добавлено через 1 минуту
Selection.copy Cells(r-1, c+1)



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 14:22

 [ТС]

7

Ощущение, что оно наоборот работает сейчас — в эту ячейку копирует значение из той, которая выше в другом столбце (то есть пустую ячейку).



0



ArtNord

370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:28

8

Проверьте перед запуском макроса, какая ячейка выбрана. Selection — текущая ячейка, в которой проверяются условия. По этой логике:

Visual Basic
1
2
3
4
5
r = Selection.row ' Получение номера строки выбранной проверяемой ячейки
c = Selection.Column ' Получение номера столбца выбранной проверяемой ячейки
If  Selection.Font.Bond = True then Selection.copy Cells(r-1, c+1) ' Проверка, если в выбранной ячейке шрифт жирный, 
                                                        'то эту ячейку скопировать в ячейку на этом же листе выше на строку и правее на столбец.
Cells(r, s).ClearContents  ' Очистить содержимое проверяемой ячейки

Здесь, вообщем-то, Cells(r, s) = Selection
Поэтому последнюю строку можно записать так:

Visual Basic
1
Selection.ClearContents



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 14:33

 [ТС]

9

Все, поняла. Отработало, спасибо. Сейчас с черным цветом еще допилю и будет оно.



0



370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:33

10

Вот и славненько!



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 14:37

 [ТС]

11

If Selection.Font.Bold = True Then Selection.Copy Cells(r — 1, c + 1) Else If (Selection.Font.ColorIndex <> 1) Then Selection.Copy Cells(r — 2, c + 2)

Вот так в итоге сделала, отрабатывает вроде бы.



0



Остап Бонд

Заблокирован

29.05.2019, 14:39

12

Можно и без лишних переменных обойтись, наверно

Visual Basic
1
2
'If  Selection.Font.Bond = True then Selection.copy Cells(r-1, c+1) ' Проверка, если в выбранной ячейке шрифт жирный, 
If  Selection.Font.BoLd = True then Selection.copy Selection.offset(-1, +1) ' Проверка, если в выбранной ячейке шрифт жирный,



1



370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:40

13



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 14:41

 [ТС]

14

Спасибо!)



0



370 / 268 / 93

Регистрация: 18.11.2015

Сообщений: 990

29.05.2019, 14:44

15

Остап Бонд, переменные я оставил так как думал, потом нужно будет пустые строки удалять



0



Остап Бонд

Заблокирован

29.05.2019, 14:48

16

Цитата
Сообщение от ArtNord
Посмотреть сообщение

Selection.Font.Bond

Вот где моё погоняло ещё не звучало



1



DDana

0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 15:05

 [ТС]

17

Я сразу исправила и дальше как-то внимания не обращала)

Пробую добавить цикл по столбцу через

Visual Basic
1
2
Dim cell As Range
For Each cell In Range("B7983:B7999")

но где-то, судя по всему, дальше лажаю с описанием выделения. Что нужно добавить, чтобы идти по каждой ячейке, выделяя ее и отправляя на проверку?



0



Vlad999

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,930

29.05.2019, 15:13

18

вместо selection применить cell

Visual Basic
1
If  cell.Font.BoLd = True then cell.copy cell.offset(-1, +1)



1



Остап Бонд

Заблокирован

29.05.2019, 15:17

19

DDana, у Вас же через три строки данные проверятся должны? Или это другая задача?



0



0 / 0 / 0

Регистрация: 29.05.2019

Сообщений: 19

29.05.2019, 15:21

 [ТС]

20

Остап Бонд, у меня таблица выглядит как простыня, в которой разное расстояние между заполненными строчками. Везде, где строчки заполнены, они заполнены вот по этому принципу — название, телефон жирным, адрес серым. Работающий макрос на ручную проверку по каждой строчке благодаря этой теме у меня есть (спасибо всем еще раз, реально круто получить ответ), я пытаюсь понять логику, каким образом можно заставить его работать в диапазоне нужных строчек (допустим, 100 строк).

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



0



Во время работы в Эксель нередко возникает необходимость в изменении порядка ячеек, например, требуется поменять местами некоторые из них. Как это сделать разными способами, разберем в данной статье.

Содержание

  1. Процедура перемещения ячеек
    • Метод 1: копирование
    • Метод 2: перетаскивание
    • Метод 3: использование макросов
  2. Заключение

Процедура перемещения ячеек

Отдельной функции, позволяющей выполнить данную процедуру в программе Excel нет. А при использовании стандартных инструментов неизбежно будет происходить сдвиг остальных ячеек, которые нужно потом вернуть на место, что в результате приведет к дополнительным действиям. Однако методы для выполнения поставленной задачи есть, и о них пойдет речь ниже.

Метод 1: копирование

Это, пожалуй, самый простой способ, который предполагает копирование элементов в другое место с заменой начальных данных. Порядок действий следующий:

  1. Встаем в первую ячейку (выделяем ее), которую планируем переместить. Находясь в главной вкладке программы нажимаем на кнопку “Копировать” (группа инструментов “Буфер обмена”). Также можно просто нажать комбинацию клавиш Ctrl+C.Копирование ячейки в Эксель
  2. Переходим в любую свободную ячейку на листе и нажимаем кнопку “Вставить” в той же вкладке и группе инструментов. Или можно снова воспользоваться горячими клавишами – Ctrl+V.Вставка скопированных данных в Эксель
  3. Теперь выделяем вторую ячейку, с которой хотим поменять местами первую, и также копируем ее.Копирование ячейки в Excel
  4. Встаем в первую ячейку и жмем кнопку “Вставить” (или Ctrl+V).Вставка скопированных данных в Excel
  5. Теперь выделяем ячейку, в которую было скопировано значение из первой ячейки и копируем ее.Копирование данных в Эксель
  6. Переходим во вторую ячейку, куда нужно вставить данные, и нажимаем соответствующую кнопку на ленте.Вставка скопированной ячейки в Эксель
  7. Выбранные элементы успешно поменяны местами. Ячейка, в которой временно размещались скопированные данные, больше не нужна. Щелкаем по ней правой кнопкой мыши и в открывшемся меню выбираем команду “Удалить”.Удаление ячейки в Эксель
  8. В зависимости от того, есть ли рядом с данной ячейкой заполненные элементы справа/снизу или нет, выбираем соответствующий вариант удаления и жмем кнопку OK.Выбор варианта удаления ячейки в Excel
  9. Вот и все, что нужно было сделать для того, чтобы поменять ячейки местами.Результата перемещения ячеек относительно друг друга в Эксель

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

Метод 2: перетаскивание

Данный метод также применяется для того, чтобы поменять местами ячейки, однако, в этом случае будет происходить сдвиг ячеек. Итак, выполняем следующие действия:

  1. Выбираем ячейку, которую планируем переместить в новое место. Наводим курсор мыши на ее границу, и как только он изменит вид на привычный указатель (с 4 стрелками в разные стороны на конце), нажав и не отпуская клавишу Shift, выполняем перенос ячейки в новое место с помощью зажатой левой кнопки мыши.Перемещение ячейки в Эксель
  2. Чаще всего, этот метод используется для того, чтобы поменять местами соседние ячейки, так как сдвиг элементов в данном случае не нарушит структуру таблицы.Смежные ячейки в Эксель
  3. Если мы решим переместить ячейку через несколько других, это повлечет за собой изменение расположения всех остальных элементов.Перемещение ячейки в Excel
  4. После этого придется восстанавливать порядок.Диапазон ячеек в Эксель

Метод 3: использование макросов

Мы упоминали в начале статьи, что в Excel, увы, нет специального инструмента, позволяющего оперативно “перекинуть” местами ячейки (за исключением метода выше, который эффективен только для смежных элементов). Однако сделать это можно с помощью макросов:

  1. Для начала нужно убедиться в том, что в приложении активирован так называемый “режим разработчика” (по умолчанию выключен). Для этого:
  2. Переключаемся во вкладку “Разработчик”, где жмем по значку “Visual Basic” (группа инструментов “Код”).Переход в редактор Visual Basic в Эксель
  3. В редакторе, нажав на кнопку “View Code”, вставляем в появившемся окне код ниже:
    Sub ПеремещениеЯчеек()
    Dim ra As Range: Set ra = Selection
    msg1 = "Произведите выделение ДВУХ диапазонов идентичного размера"
    msg2 = "Произведите выделение двух диапазонов ИДЕНТИЧНОГО размера"
    If ra.Areas.Count <> 2 Then MsgBox msg1, vbCritical, "Проблема": Exit Sub
    If ra.Areas(1).Count <> ra.Areas(2).Count Then MsgBox msg2, vbCritical, "Проблема": Exit Sub
    Application.ScreenUpdating = False
    arr2 = ra.Areas(2).Value
    ra.Areas(2).Value = ra.Areas(1).Value
    ra.Areas(1).Value = arr2
    End Sub
    Код для макроса замены ячеек местами в Эксель
  4. Закрываем окно редактора, щелкнув привычную кнопку в виде крестика в верхнем правом углу.
  5. Зажав клавишу Ctrl на клавиатуре выделяем две ячейки или две области с одинаковым количество элементов, которые планируем поменять местами. Затем нажимаем кнопку “Макросы” (вкладка “Разработчик”, группа “Код”).Активация макроса в Эксель для выбранных ячеек
  6. Появится окно, в котором мы видим ранее созданный макрос. Выбираем его и щелкаем “Выполнить”.Выбор макроса в Excel
  7. В результате работы макрос поменяет местами содержимое выделенных ячеек.Результат замены местами ячеек в Эксель с помощью макроса

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

Сохранение документа Excel с поддержкой макросов

Заключение

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

How to copy and paste data using a Macro in Excel. I’ll show you multiple ways to do this, including across worksheets and workbooks.

Sections:

Simple Copy/Paste

Copy Entire Range

Copy between Worksheets

Copy between Workbooks

Notes

Simple Copy/Paste

Range("A1").Copy Range("B1")

This copies cell A1 to cell B1.

Range(«A1»).Copy is the part that copies the cell.

Range(«B1») is the cell where the data will be copied.

This is a simple one line piece of code and it’s very easy to use.

Notice that there is a space between these two parts of the code.

Copy Entire Range

Range("A1:A5").Copy Range("B1:B5")

Range(«A1:A5»).Copy is the part that copies the range.

Range(«B1:B5») is the range where the data will be copied.

You can also write it like this:

Range("A1:A5").Copy Range("B1")

Notice that the range to where you will copy the data has only a reference to cell B1.

You only have to reference the very first cell to which the range will be copied and the entire range will copy in the cells below there.

NOTE: if you do it like this, you may end up overwriting data and Excel will not give you a warning about this; the data will simply be filled down as far as it needs to go to copy the first range.

Copy between Worksheets

Sheets("Sheet1").Range("A1").Copy Sheets("Sheet2").Range("B1")

This follows the same pattern as the above examples except that we need to tell the macro from which sheet we want to get the data and to which sheet we want to copy the data.

Sheets(«Sheet1»). is placed in front of the first range and that means to get the data from Sheet1, which is the name of a worksheet in the workbook.

Sheets(«Sheet2»). is placed in front of the range to which we want to copy the data and Sheet2 is the name of the worksheet where the data will be copied.

Copy between Workbooks

Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet1").Range("A1").Copy Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet3").Range("A1")

Here, we follow the above examples and, this time, add a reference to the workbooks from which we want to get the data and to which we want to place the data.

Workbooks(«Copy and Paste Data using Macro VBA in Excel.xlsm»). is the code that says in which workbook we want to place the data. Copy and Paste Data using Macro VBA in Excel.xlsm is the name of the workbook. In this example I used this for both parts, the workbook from which the data comes and where it goes. This allows you to run this macro within a single workbook and still show you how it works. In a real-world example, the first part contains the name of the workbook where you get the data from and the second contains the name of the workbook where you want to place the data.

Read this tutorial to copy values from another workbook, even if it’s closed.

Notes

All examples in the attached workbook have been commented out. Simply remove the single quote from the line of code you want to test and then run the macro.

cf5e0ebf6d62c9ec73df03c55f727e77.jpg

Download the attached file to get these examples in Excel.

Similar Content on TeachExcel

Activate or Navigate to a Worksheet using Macros VBA in Excel

Tutorial: Make a particular worksheet visible using a macro in Excel.
This is called activating a wo…

Get the Name of a Worksheet in Macros VBA in Excel

Tutorial: How to get the name of a worksheet in Excel using VBA and Macros and also how to store tha…

Get the Last Row using VBA in Excel

Tutorial:
(file used in the video above)
How to find the last row of data using a Macro/VBA in Exce…

Remove Dashed Lines from Copy Paste VBA in Excel

Tutorial: How to remove the flashing dashes from a copy/paste range using VBA in Excel; this removes…

Copy one range and paste in another range

Tutorial: Below is a macro, just copy and paste it into a module in your workbook and go from there…

Guide to Combine and Consolidate Data in Excel

Tutorial: Guide to combining and consolidating data in Excel. This includes consolidating data from …

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Понравилась статья? Поделить с друзьями:
  • Макрос в excel галочка
  • Макрос в excel выполнение по времени
  • Макрос word выделить весь документ
  • Макрос word выделенный текст
  • Макрос в excel выделить текущую строку