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

Вход

Регистрация

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

 

= Мир MS Excel/Данные из одной таблицы в другую,с соблюдением цвета ячейки - Мир MS Excel

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

Excel 2010
здравствуйте!
Не знаю, может зря создал эту тему, так что модераторы не баньте.
Есть 2 Листа. В таблице 1 данные_Лист 1. Их нужно перенести. с соблюдением цвета и определенного условия переносимой ячейки на Лист "Проба".
Файл-пример прилагаю.
Тема была на форуме "Вопросы по Эксель". Формула помогла, но решение по цвету нет, или пока пауза.
Цвет нужен для подсчета по макросу позиций заполнения проемов.
Нужные ячейки, границы, выделены жирным и закрашены для удобства желтым цветом.
К сообщению приложен файл: 6083658.xlsm (33.0 Kb)
 
Ответить
Сообщениездравствуйте!
Не знаю, может зря создал эту тему, так что модераторы не баньте.
Есть 2 Листа. В таблице 1 данные_Лист 1. Их нужно перенести. с соблюдением цвета и определенного условия переносимой ячейки на Лист "Проба".
Файл-пример прилагаю.
Тема была на форуме "Вопросы по Эксель". Формула помогла, но решение по цвету нет, или пока пауза.
Цвет нужен для подсчета по макросу позиций заполнения проемов.
Нужные ячейки, границы, выделены жирным и закрашены для удобства желтым цветом.
Автор - concore
Дата добавления - 13.08.2017 в 17:33
_Boroda_ Дата: Воскресенье, 13.08.2017, 18:34 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("V12")) Is Nothing Then
        On Error Resume Next
        With Sheets("Таблица 1")
            r_ = WorksheetFunction.Match(Range("V12"), .Range("C:C"), 0)
            If Err Then
                Range("V15").Interior.Pattern = xlNone
                Exit Sub
            End If
            ic_ = .Range("D" & r_).Interior.Color
        End With
        Range("V15").Interior.Color = ic_
    End If
End Sub
[/vba]
============
А перенос мы уже сделали ВПР-ом в предыдущей теме
Файл с ВПР перевложил
К сообщению приложен файл: 6083658_1.xlsm (35.0 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("V12")) Is Nothing Then
        On Error Resume Next
        With Sheets("Таблица 1")
            r_ = WorksheetFunction.Match(Range("V12"), .Range("C:C"), 0)
            If Err Then
                Range("V15").Interior.Pattern = xlNone
                Exit Sub
            End If
            ic_ = .Range("D" & r_).Interior.Color
        End With
        Range("V15").Interior.Color = ic_
    End If
End Sub
[/vba]
============
А перенос мы уже сделали ВПР-ом в предыдущей теме
Файл с ВПР перевложил
Автор - _Boroda_
Дата добавления - 13.08.2017 в 18:34
Kuzmich Дата: Воскресенье, 13.08.2017, 18:43 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Их нужно перенести. с соблюдением цвета и определенного условия переносимой ячейки на Лист "Проба".

В модуль листа Проба
[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AJ12")) Is Nothing Then
Dim FoundPosition As Range
    Application.EnableEvents = False
    With Worksheets("Таблица 1")
      Set FoundPosition = .Columns(3).Find(Target, , xlValues, xlWhole)
      .Cells(FoundPosition.Row, "D").Copy Range("AJ13")     'шифр
      .Cells(FoundPosition.Row, "E").Copy
      Range("AJ15").PasteSpecial xlPasteFormats
      Range("AJ15").PasteSpecial xlPasteValuesAndNumberFormats     'площадь
    End With
End If
   Application.EnableEvents = True
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
Их нужно перенести. с соблюдением цвета и определенного условия переносимой ячейки на Лист "Проба".

В модуль листа Проба
[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AJ12")) Is Nothing Then
Dim FoundPosition As Range
    Application.EnableEvents = False
    With Worksheets("Таблица 1")
      Set FoundPosition = .Columns(3).Find(Target, , xlValues, xlWhole)
      .Cells(FoundPosition.Row, "D").Copy Range("AJ13")     'шифр
      .Cells(FoundPosition.Row, "E").Copy
      Range("AJ15").PasteSpecial xlPasteFormats
      Range("AJ15").PasteSpecial xlPasteValuesAndNumberFormats     'площадь
    End With
End If
   Application.EnableEvents = True
End Sub
[/vba]
Автор - Kuzmich
Дата добавления - 13.08.2017 в 18:43
petyavova Дата: Вторник, 15.08.2017, 06:31 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
контрагенты прибавляются и отваливаются, соответственно
при копировании нового листа в итоговый файл они добавляются, но в динамике не участвуют. Попытался с помощью присвоения переменной номера цвета, которым выделена ячейка с ИНН выделить и скопировать на страницу динамики в столбец ИНН, ничего не получилось.
Можете подсказать, как скопировать из второго листа все ИНН выделенные цветом на первый лист с добавлением отсутствующих.
образец примерный прилагаю.
К сообщению приложен файл: 8333653.xlsx (12.4 Kb)
 
Ответить
Сообщениеконтрагенты прибавляются и отваливаются, соответственно
при копировании нового листа в итоговый файл они добавляются, но в динамике не участвуют. Попытался с помощью присвоения переменной номера цвета, которым выделена ячейка с ИНН выделить и скопировать на страницу динамики в столбец ИНН, ничего не получилось.
Можете подсказать, как скопировать из второго листа все ИНН выделенные цветом на первый лист с добавлением отсутствующих.
образец примерный прилагаю.
Автор - petyavova
Дата добавления - 15.08.2017 в 06:31
Pelena Дата: Вторник, 15.08.2017, 07:17 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19177
Репутация: 4417 ±
Замечаний: ±

Excel 365 & Mac Excel
petyavova, создайте свою тему со своим вопросом

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениеpetyavova, создайте свою тему со своим вопросом
Автор - Pelena
Дата добавления - 15.08.2017 в 07:17
concore Дата: Вторник, 15.08.2017, 18:14 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
не получается


Сообщение отредактировал concore - Вторник, 15.08.2017, 18:14
 
Ответить
Сообщениене получается
Автор - concore
Дата добавления - 15.08.2017 в 18:14
concore Дата: Вторник, 15.08.2017, 18:22 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Уважаемые
Boroda и Kuzmich
спасибо, но не получается.
Boroda, при копировании и вставки все слетает.
Kuzmich, как запускать созданный Вами макрос?
Создал другой файл-пример. точнее расписал что и как мне нужно делать. что копировать. куда переносить и где заполнять.
К сообщению приложен файл: 4075071.xlsx (31.9 Kb)
 
Ответить
СообщениеУважаемые
Boroda и Kuzmich
спасибо, но не получается.
Boroda, при копировании и вставки все слетает.
Kuzmich, как запускать созданный Вами макрос?
Создал другой файл-пример. точнее расписал что и как мне нужно делать. что копировать. куда переносить и где заполнять.
Автор - concore
Дата добавления - 15.08.2017 в 18:22
RAN Дата: Вторник, 15.08.2017, 18:44 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Не получается - показываю, что не получается - логично.
Не получается - НЕ показываю, что НЕ получается - ??????

Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНе получается - показываю, что не получается - логично.
Не получается - НЕ показываю, что НЕ получается - ??????
Автор - RAN
Дата добавления - 15.08.2017 в 18:44
Kuzmich Дата: Вторник, 15.08.2017, 19:39 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Kuzmich, как запускать созданный Вами макрос?

Макрос в модуль листа Проба
Макрос срабатывает при изменении ячейки AJ12 листа Проба.
Вы выбираете номер позиции из выпадающего списка, а шифр
и площадь проема подтягиваются макросом с листа "Таблица 1"
 
Ответить
Сообщение
Цитата
Kuzmich, как запускать созданный Вами макрос?

Макрос в модуль листа Проба
Макрос срабатывает при изменении ячейки AJ12 листа Проба.
Вы выбираете номер позиции из выпадающего списка, а шифр
и площадь проема подтягиваются макросом с листа "Таблица 1"
Автор - Kuzmich
Дата добавления - 15.08.2017 в 19:39
concore Дата: Вторник, 15.08.2017, 21:38 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Kuzmich
Сейчас попробую
 
Ответить
СообщениеKuzmich
Сейчас попробую
Автор - concore
Дата добавления - 15.08.2017 в 21:38
concore Дата: Вторник, 15.08.2017, 22:02 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Kuzmich
Установил макрос в модуль листа.
Цитата Kuzmich, 13.08.2017 в 18:43, в сообщении № 3 ()
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AD12")) Is Nothing Then
Dim FoundPosition As Range
    Application.EnableEvents = False
    With Worksheets("Заполнение Проемов")
    Set FoundPosition = .Columns(3).Find(Target, , xlValues, xlWhole)
    .Cells(FoundPosition.Row, "D").Copy Range("AD13")     'шифр
    .Cells(FoundPosition.Row, "E").Copy
    Range("AD14").PasteSpecial xlPasteFormats
    Range("AD14").PasteSpecial xlPasteValuesAndNumberFormats     'площадь
    End With
End If
Application.EnableEvents = True
End Sub

1. Подправил под новую таблицу, но все равно при изменении из списка не работает. что изменил выделено красным, может я ОШИБСЯ? Ни каких изменений и в старом файле-примере нет.
2. если я правильно понял, то при копировании таблицы шаблона и переносе её все слетит? там вроде бы привязка к определенным ячейкам?
К сообщению приложен файл: 9959838.xlsm (37.1 Kb)
 
Ответить
СообщениеKuzmich
Установил макрос в модуль листа.
Цитата Kuzmich, 13.08.2017 в 18:43, в сообщении № 3 ()
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AD12")) Is Nothing Then
Dim FoundPosition As Range
    Application.EnableEvents = False
    With Worksheets("Заполнение Проемов")
    Set FoundPosition = .Columns(3).Find(Target, , xlValues, xlWhole)
    .Cells(FoundPosition.Row, "D").Copy Range("AD13")     'шифр
    .Cells(FoundPosition.Row, "E").Copy
    Range("AD14").PasteSpecial xlPasteFormats
    Range("AD14").PasteSpecial xlPasteValuesAndNumberFormats     'площадь
    End With
End If
Application.EnableEvents = True
End Sub

1. Подправил под новую таблицу, но все равно при изменении из списка не работает. что изменил выделено красным, может я ОШИБСЯ? Ни каких изменений и в старом файле-примере нет.
2. если я правильно понял, то при копировании таблицы шаблона и переносе её все слетит? там вроде бы привязка к определенным ячейкам?
Автор - concore
Дата добавления - 15.08.2017 в 22:02
concore Дата: Вторник, 15.08.2017, 22:07 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Kuzmich
Прикладываю и старый файл-пример с Вашим макросом, без изменений.
К сообщению приложен файл: 4824487.xlsm (36.1 Kb)


Сообщение отредактировал concore - Вторник, 15.08.2017, 22:13
 
Ответить
СообщениеKuzmich
Прикладываю и старый файл-пример с Вашим макросом, без изменений.
Автор - concore
Дата добавления - 15.08.2017 в 22:07
Kuzmich Дата: Вторник, 15.08.2017, 22:56 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Для новой таблицы макрос должен быть в модуле листа Шаблон и расчеты.
В ячейке AD12 организован выпадающий список, при выборе нужного значения
номера позиции макросом подтягиваются шифр и площадь из листа Заполнение Проемов.
На мой взгляд все расчеты надо делать в Шаблоне, а потом переносить его в нужное
место листа.
К сообщению приложен файл: ___10-34893-1.xls (87.0 Kb)
 
Ответить
СообщениеДля новой таблицы макрос должен быть в модуле листа Шаблон и расчеты.
В ячейке AD12 организован выпадающий список, при выборе нужного значения
номера позиции макросом подтягиваются шифр и площадь из листа Заполнение Проемов.
На мой взгляд все расчеты надо делать в Шаблоне, а потом переносить его в нужное
место листа.
Автор - Kuzmich
Дата добавления - 15.08.2017 в 22:56
concore Дата: Вторник, 15.08.2017, 23:31 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Kuzmich
заполнил шаблон и перенес. Начал изменять шаблон. вносить другие изменения, и не чего не происходит. Обратил внимание, у Вас прописана ячейка AD12, при копировании и вставки ячейка меняется и макрос похоже уже не работает (((. Если я правильно понял
Файл прилагаю
К сообщению приложен файл: _10-34893-1.xls (82.0 Kb)


Сообщение отредактировал concore - Вторник, 15.08.2017, 23:34
 
Ответить
СообщениеKuzmich
заполнил шаблон и перенес. Начал изменять шаблон. вносить другие изменения, и не чего не происходит. Обратил внимание, у Вас прописана ячейка AD12, при копировании и вставки ячейка меняется и макрос похоже уже не работает (((. Если я правильно понял
Файл прилагаю
Автор - concore
Дата добавления - 15.08.2017 в 23:31
Kuzmich Дата: Вторник, 15.08.2017, 23:42 | Сообщение № 15
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Обратил внимание, у Вас прописана ячейка AD12

В вашем последнем примере это уже ячейка AB12. Поменяйте в коде
столбец AD на AB.
 
Ответить
Сообщение
Цитата
Обратил внимание, у Вас прописана ячейка AD12

В вашем последнем примере это уже ячейка AB12. Поменяйте в коде
столбец AD на AB.
Автор - Kuzmich
Дата добавления - 15.08.2017 в 23:42
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Данные из одной таблицы в другую,с соблюдением цвета ячейки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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