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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование строк таблицы в разные листы по условию - Мир MS Excel

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

Excel 2013
Доброго времени суток, уважаемые форумчане! :)

Нужна помощь в написании макроса. :(

Суть идеи такова:
1. Имеется таблица 23 столбца (лист "ДАНО")
2. Ориентир столбец №3 (в нем содержатся или ДО или РНС или ДМТР)
3. Если в столбце №3 ДО то строчку таблицы копируем на лист "ДО", если РНС то копируем на лист "РНС", соответственно ДМТР копируем строку на лист "ДМТР"
4. на лист "сводная" копируем строчки с ДО но только выборочные столбцы (номера столбцов я указал в примере).

Если возможно, то с комментариями в коде, т.к. сам пытаюсь изучать VBA, чтоб потом можно было разобраться %) :(
К сообщению приложен файл: 45764576.xlsm (28.6 Kb)


Сообщение отредактировал Aleksej - Среда, 16.03.2016, 11:04
 
Ответить
СообщениеДоброго времени суток, уважаемые форумчане! :)

Нужна помощь в написании макроса. :(

Суть идеи такова:
1. Имеется таблица 23 столбца (лист "ДАНО")
2. Ориентир столбец №3 (в нем содержатся или ДО или РНС или ДМТР)
3. Если в столбце №3 ДО то строчку таблицы копируем на лист "ДО", если РНС то копируем на лист "РНС", соответственно ДМТР копируем строку на лист "ДМТР"
4. на лист "сводная" копируем строчки с ДО но только выборочные столбцы (номера столбцов я указал в примере).

Если возможно, то с комментариями в коде, т.к. сам пытаюсь изучать VBA, чтоб потом можно было разобраться %) :(

Автор - Aleksej
Дата добавления - 16.03.2016 в 11:04
KuklP Дата: Среда, 16.03.2016, 11:39 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
[vba]
Код
Public Sub www()
    Dim a, i&, sh As Worksheet
    a = Array("ДО", "РНС", "ДМТР")
    For i = 0 To 2
        Me.[b19].CurrentRegion.AutoFilter 3, a(i)
        Me.[b19].CurrentRegion.SpecialCells(12).Copy Sheets(a(i)).[b7]
        If a(i) = "ДО" Then
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range(("b:d,H:h,m:m,y:y"))).Copy Sheets("Сводная").[b7]
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range("H:h,r:r")).Copy Sheets("Сводная").[h7]
        End If
    Next
    Me.AutoFilterMode = 0
End Sub
[/vba]
К сообщению приложен файл: 4576.xlsm (34.3 Kb)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[vba]
Код
Public Sub www()
    Dim a, i&, sh As Worksheet
    a = Array("ДО", "РНС", "ДМТР")
    For i = 0 To 2
        Me.[b19].CurrentRegion.AutoFilter 3, a(i)
        Me.[b19].CurrentRegion.SpecialCells(12).Copy Sheets(a(i)).[b7]
        If a(i) = "ДО" Then
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range(("b:d,H:h,m:m,y:y"))).Copy Sheets("Сводная").[b7]
            Intersect(Me.[b19].CurrentRegion.SpecialCells(12), Me.Range("H:h,r:r")).Copy Sheets("Сводная").[h7]
        End If
    Next
    Me.AutoFilterMode = 0
End Sub
[/vba]

Автор - KuklP
Дата добавления - 16.03.2016 в 11:39
Aleksej Дата: Среда, 16.03.2016, 11:55 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, спасибо большое :) , вроде все работает. :hands:

Только я то хотел посмотреть код, разобраться, а у тебя часть функций спрятана под пароль. :)
Работает конечно, но каким образом непонятно. <_<


Сообщение отредактировал Aleksej - Среда, 16.03.2016, 14:15
 
Ответить
СообщениеKuklP, спасибо большое :) , вроде все работает. :hands:

Только я то хотел посмотреть код, разобраться, а у тебя часть функций спрятана под пароль. :)
Работает конечно, но каким образом непонятно. <_<

Автор - Aleksej
Дата добавления - 16.03.2016 в 11:55
Hugo Дата: Среда, 16.03.2016, 18:14 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
Aleksej, не вижу там никаких паролей (только ради этого файл скачал :) ), да и даже если бы были - код ведь вот он, в посте.
P.S. Сергей, привет! :)


excel@nxt.ru
webmoney: E265281470651 Z422237915069
 
Ответить
СообщениеAleksej, не вижу там никаких паролей (только ради этого файл скачал :) ), да и даже если бы были - код ведь вот он, в посте.
P.S. Сергей, привет! :)

Автор - Hugo
Дата добавления - 16.03.2016 в 18:14
KuklP Дата: Среда, 16.03.2016, 19:18 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Привет, дружище. :) Ну да, кто-кто, а я как раз бы пароли ставил. :D


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеПривет, дружище. :) Ну да, кто-кто, а я как раз бы пароли ставил. :D

Автор - KuklP
Дата добавления - 16.03.2016 в 19:18
Aleksej Дата: Среда, 23.03.2016, 07:45 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, Добрый день! Да точно нет пароля, извиняюсь :)
Просто был открыт другой документ экселя, а в редакторе VBA они же вместе показываются. :)

С кодом мало мальски разобрался, но не полностью.
1. не могу понять что такое "sh"
2. Почему когда удаляешь номера столбцов в листе ДАНО, макрос перестает сортировать, не могу понять как он связан с нумерацией столбцов? %)
3. Почему макрос копирует нумерацию, если в коде указано начинать сортировку со строчки ниже, тоже непонятно?

Спасибо ещё раз за помощь! :)
 
Ответить
СообщениеKuklP, Добрый день! Да точно нет пароля, извиняюсь :)
Просто был открыт другой документ экселя, а в редакторе VBA они же вместе показываются. :)

С кодом мало мальски разобрался, но не полностью.
1. не могу понять что такое "sh"
2. Почему когда удаляешь номера столбцов в листе ДАНО, макрос перестает сортировать, не могу понять как он связан с нумерацией столбцов? %)
3. Почему макрос копирует нумерацию, если в коде указано начинать сортировку со строчки ниже, тоже непонятно?

Спасибо ещё раз за помощь! :)

Автор - Aleksej
Дата добавления - 23.03.2016 в 07:45
KuklP Дата: Среда, 23.03.2016, 10:20 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
1. не могу понять что такое "sh"
ничего, это лишнее, писалось "на вырост" и не пригодилось. Можно убрать.
2),3) - непонятно о чем. Ни в макросе ни в топике ни о какой сортировке речь не идет.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
1. не могу понять что такое "sh"
ничего, это лишнее, писалось "на вырост" и не пригодилось. Можно убрать.
2),3) - непонятно о чем. Ни в макросе ни в топике ни о какой сортировке речь не идет.

Автор - KuklP
Дата добавления - 23.03.2016 в 10:20
Aleksej Дата: Среда, 23.03.2016, 11:35 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, спс что ответил :)
под сортировкой я имел ввиду:
- если ДО то на один лист копирует
- РНС на другой лист и т.д. (типа сортирует :) )

Я не могу понять, почему если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать,
а если не удалять то он эту строку за собой на все листы тащит?
 
Ответить
СообщениеKuklP, спс что ответил :)
под сортировкой я имел ввиду:
- если ДО то на один лист копирует
- РНС на другой лист и т.д. (типа сортирует :) )

Я не могу понять, почему если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать,
а если не удалять то он эту строку за собой на все листы тащит?

Автор - Aleksej
Дата добавления - 23.03.2016 в 11:35
KuklP Дата: Среда, 23.03.2016, 11:49 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать
так если удалить всю книгу, то и макроса не будет. Странный вопрос. Вам наверное надо начать с чего-то попроще. Что такое таблица, что такое заголовки.

а если не удалять то он эту строку за собой на все листы тащит?
а где в топике написано, что этого делать не надо?

P.S. да кстати:
KuklP, спс что ответил
мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
если с листа ДАНО, очистить или удалить строку с нумерацией столбцов (1, 2, 3, 4.1, 4.2, 5, 6 и т.д.), макрос перестает работать
так если удалить всю книгу, то и макроса не будет. Странный вопрос. Вам наверное надо начать с чего-то попроще. Что такое таблица, что такое заголовки.

а если не удалять то он эту строку за собой на все листы тащит?
а где в топике написано, что этого делать не надо?

P.S. да кстати:
KuklP, спс что ответил
мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.

Автор - KuklP
Дата добавления - 23.03.2016 в 11:49
Aleksej Дата: Среда, 23.03.2016, 12:28 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP,
Цитата
мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.

Цитата
Привет, дружище.
Сами же написали :) Извиняюсь если что не так. :)

Цитата
а где в топике написано, что этого делать не надо?

Я же не говорил что сделали не так, просто разобраться хочу :). Решил проблему частично, после копирования добавил в код чтоб удалять эту строку.

Цитата
Вам наверное надо начать с чего-то попроще.

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


Сообщение отредактировал Aleksej - Среда, 23.03.2016, 12:40
 
Ответить
СообщениеKuklP,
Цитата
мы с Вами старые приятели? Что-то не припомню.. Я вот к Вам на Вы.

Цитата
Привет, дружище.
Сами же написали :) Извиняюсь если что не так. :)

Цитата
а где в топике написано, что этого делать не надо?

Я же не говорил что сделали не так, просто разобраться хочу :). Решил проблему частично, после копирования добавил в код чтоб удалять эту строку.

Цитата
Вам наверное надо начать с чего-то попроще.

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

Автор - Aleksej
Дата добавления - 23.03.2016 в 12:28
KuklP Дата: Среда, 23.03.2016, 13:04 | Сообщение № 11
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Сами же написали
Это я обращался к Игорю Hugo. Ладно, проехали. По поводу заголовков почитайте справку по resize и offset, там и примеры были. Вам в принципе достаточно offset, но для resize пример поподробней.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
Сами же написали
Это я обращался к Игорю Hugo. Ладно, проехали. По поводу заголовков почитайте справку по resize и offset, там и примеры были. Вам в принципе достаточно offset, но для resize пример поподробней.

Автор - KuklP
Дата добавления - 23.03.2016 в 13:04
Wasilich Дата: Среда, 23.03.2016, 13:38 | Сообщение № 12
Группа: Друзья
Ранг: Старожил
Сообщений: 1232
Репутация: 326 ±
Замечаний: 0% ±

2003
Может этот макрос упростит понимание, применение и снизит скорость. :D
[vba]
Код
Sub www()
  Dim R1&, R2&, R3&, i&
  R1 = 7: R2 = 7: R3 = 7
  For i = 20 To Range("D" & Rows.Count).End(xlUp).Row
    Select Case Cells(i, 4)
      Case "ДО"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("ДО").Cells(R1, 2)
        Union(Cells(i, "B"), Cells(i, "C"), Cells(i, "D")).Copy Sheets("Сводная").Cells(R1, 2)
        Union(Cells(i, "H"), Cells(i, "M"), Cells(i, "Y")).Copy Sheets("Сводная").Cells(R1, 5)
        Union(Cells(i, "H"), Cells(i, "R")).Copy Sheets("Сводная").Cells(R1, 8)
        R1 = R1 + 1
      Case "РНС"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("РНС").Cells(R2, 2)
        R2 = R2 + 1
      Case "ДМТР"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("ДМТР").Cells(R3, 2)
        R3 = R3 + 1
    End Select
  Next
End Sub
[/vba]
 
Ответить
СообщениеМожет этот макрос упростит понимание, применение и снизит скорость. :D
[vba]
Код
Sub www()
  Dim R1&, R2&, R3&, i&
  R1 = 7: R2 = 7: R3 = 7
  For i = 20 To Range("D" & Rows.Count).End(xlUp).Row
    Select Case Cells(i, 4)
      Case "ДО"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("ДО").Cells(R1, 2)
        Union(Cells(i, "B"), Cells(i, "C"), Cells(i, "D")).Copy Sheets("Сводная").Cells(R1, 2)
        Union(Cells(i, "H"), Cells(i, "M"), Cells(i, "Y")).Copy Sheets("Сводная").Cells(R1, 5)
        Union(Cells(i, "H"), Cells(i, "R")).Copy Sheets("Сводная").Cells(R1, 8)
        R1 = R1 + 1
      Case "РНС"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("РНС").Cells(R2, 2)
        R2 = R2 + 1
      Case "ДМТР"
        Range(Cells(i, 2), Cells(i, 25)).Copy Sheets("ДМТР").Cells(R3, 2)
        R3 = R3 + 1
    End Select
  Next
End Sub
[/vba]

Автор - Wasilich
Дата добавления - 23.03.2016 в 13:38
Aleksej Дата: Среда, 23.03.2016, 14:07 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, Спасибо!
 
Ответить
СообщениеKuklP, Спасибо!

Автор - Aleksej
Дата добавления - 23.03.2016 в 14:07
Aleksej Дата: Среда, 23.03.2016, 14:14 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 69
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Wasilich, Спасибо! :) Я когда собирался написать макрос, примерно так его и представлял, сейчас буду разбираться. :)

Поэтому я и впал в ступор когда увидел код KuklP :D решение по своему интересное и для меня неожиданное. :)


Сообщение отредактировал Aleksej - Среда, 23.03.2016, 14:42
 
Ответить
Сообщение Wasilich, Спасибо! :) Я когда собирался написать макрос, примерно так его и представлял, сейчас буду разбираться. :)

Поэтому я и впал в ступор когда увидел код KuklP :D решение по своему интересное и для меня неожиданное. :)

Автор - Aleksej
Дата добавления - 23.03.2016 в 14:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование строк таблицы в разные листы по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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