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

Вход

Регистрация

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

 

= Мир MS Excel/При нажатии на ячейку заполняем таблицу данными - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » При нажатии на ячейку заполняем таблицу данными (Worksheet_SelectionChange)
При нажатии на ячейку заполняем таблицу данными
BloOmer Дата: Среда, 13.02.2019, 14:58 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Уважаемые форумчане, не хватает мозгов помогите пожалуйста.
С VBA совсем недавно работаю, один человек помог мне разработать макрос, но он не совсем полностью работает)

Есть таблица поставщиков и необходимой информации о ней (адрес, телефон, контактное лицо) на листе №1
Есть таблица тех же поставщиков и товаров, которые они поставляют на листе №2
В рабочем виде товары (столбцы) делятся еще на 3 группы: цена, производитель, количество.
В отчетном виде столбцы производитель и качество скрываются, остаются только цены.
Есть макрос в событии Worksheet_SelectionChange при нажатии на ячейку с ценой снизу заполняется таблица согласно данным таблицы с листа №1 и скрытым столбцам с листа №2
[vba]
Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr1(), a&, aa As Range, bb As Range, dd(), F As Range, arr()
Set bb = Columns("A").Find("Поставщик:", , xlValues, xlWhole, xlByColumns, , False)
If bb Is Nothing Then Exit Sub
If Not Intersect(Target, Columns("B"), Rows("2:" & bb.Row - 5)) Is Nothing And Target.Count = 1 Then
  Set aa = Sheets(1).Columns("A").Find(Target.Offset(, -1), , xlValues, xlWhole, xlByColumns, , False)
  If aa Is Nothing Then Exit Sub
  arr = Rows(bb.Row & ":" & bb.Row + 7).Columns(1).Value
  arr1 = Intersect(Target.EntireRow, Me.UsedRange).Value
  ReDim dd(1 To 8): dd(1) = aa
  For a = 2 To 5
    Set F = Sheets(1).Rows(1).Find(Replace(arr(a, 1), ":", ""), , xlValues, xlWhole, xlByRows, , False)
    If Not F Is Nothing Then dd(a) = Intersect(aa.EntireRow, F.EntireColumn).Value
  Next
  dd(7) = arr1(1, 3): dd(8) = arr1(1, 4)
  With Application
    .EnableEvents = False
    bb.Offset(, 1).Resize(UBound(dd), 1).Value = .Transpose(dd)
    .EnableEvents = True
  End With
End If
End Sub
[/vba]

Проблема в том, что макрос работает только со столбцом "В", нужно что бы он работал с "В","E","Н"... и далее до бесконечности
То бишь, при нажатии на любую цену, таргет находит крайнее левое значение, ищет его в первом листе и заполняет таблицу на листе 2, отталкиваясь от него.
Не знаю насколько понятно объяснил, проще понять на примере с файла:
К сообщению приложен файл: TEST.xlsm(23.0 Kb)
 
Ответить
СообщениеУважаемые форумчане, не хватает мозгов помогите пожалуйста.
С VBA совсем недавно работаю, один человек помог мне разработать макрос, но он не совсем полностью работает)

Есть таблица поставщиков и необходимой информации о ней (адрес, телефон, контактное лицо) на листе №1
Есть таблица тех же поставщиков и товаров, которые они поставляют на листе №2
В рабочем виде товары (столбцы) делятся еще на 3 группы: цена, производитель, количество.
В отчетном виде столбцы производитель и качество скрываются, остаются только цены.
Есть макрос в событии Worksheet_SelectionChange при нажатии на ячейку с ценой снизу заполняется таблица согласно данным таблицы с листа №1 и скрытым столбцам с листа №2
[vba]
Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr1(), a&, aa As Range, bb As Range, dd(), F As Range, arr()
Set bb = Columns("A").Find("Поставщик:", , xlValues, xlWhole, xlByColumns, , False)
If bb Is Nothing Then Exit Sub
If Not Intersect(Target, Columns("B"), Rows("2:" & bb.Row - 5)) Is Nothing And Target.Count = 1 Then
  Set aa = Sheets(1).Columns("A").Find(Target.Offset(, -1), , xlValues, xlWhole, xlByColumns, , False)
  If aa Is Nothing Then Exit Sub
  arr = Rows(bb.Row & ":" & bb.Row + 7).Columns(1).Value
  arr1 = Intersect(Target.EntireRow, Me.UsedRange).Value
  ReDim dd(1 To 8): dd(1) = aa
  For a = 2 To 5
    Set F = Sheets(1).Rows(1).Find(Replace(arr(a, 1), ":", ""), , xlValues, xlWhole, xlByRows, , False)
    If Not F Is Nothing Then dd(a) = Intersect(aa.EntireRow, F.EntireColumn).Value
  Next
  dd(7) = arr1(1, 3): dd(8) = arr1(1, 4)
  With Application
    .EnableEvents = False
    bb.Offset(, 1).Resize(UBound(dd), 1).Value = .Transpose(dd)
    .EnableEvents = True
  End With
End If
End Sub
[/vba]

Проблема в том, что макрос работает только со столбцом "В", нужно что бы он работал с "В","E","Н"... и далее до бесконечности
То бишь, при нажатии на любую цену, таргет находит крайнее левое значение, ищет его в первом листе и заполняет таблицу на листе 2, отталкиваясь от него.
Не знаю насколько понятно объяснил, проще понять на примере с файла:

Автор - BloOmer
Дата добавления - 13.02.2019 в 14:58
Glen Дата: Среда, 13.02.2019, 16:47 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010
Так?
К сообщению приложен файл: 8176169.xlsm(21.3 Kb)


Самурай без меча подобен самураю с мечом, но только без меча.
 
Ответить
СообщениеТак?

Автор - Glen
Дата добавления - 13.02.2019 в 16:47
BloOmer Дата: Среда, 13.02.2019, 17:36 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Glen, даже лучше, чем я просил) я думал насчет идеи использовать любую ячейку в макросе, но решил, что если тыкать не на цену, то собьется инфа в таблице и вместо производителя будет стоять цена, а вместо количества производитель, но вы сделали идеально, спасибо большое!
 
Ответить
СообщениеGlen, даже лучше, чем я просил) я думал насчет идеи использовать любую ячейку в макросе, но решил, что если тыкать не на цену, то собьется инфа в таблице и вместо производителя будет стоять цена, а вместо количества производитель, но вы сделали идеально, спасибо большое!

Автор - BloOmer
Дата добавления - 13.02.2019 в 17:36
krosav4ig Дата: Среда, 13.02.2019, 18:35 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1998
Репутация: 841 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще вариант, формульный
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("строка")-СТРОКА(Таблица2)+1;1)
Код
=ТРАНСП(ИНДЕКС(Таблица1[[Адрес склада]:[Телефон]];ПОИСКПОЗ(B9;Таблица1[Название организации];);))
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("row")-СТРОКА(Таблица2)+1;ОКРВВЕРХ(ЯЧЕЙКА("col")-1;3))
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("row")-СТРОКА(Таблица2)+1;ОКРВВЕРХ(ЯЧЕЙКА("col")-1;3)+1)

и макрос для пересчета формул
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [Таблица2]) Is Nothing And Target.Count = 1 Then
        Cells(Rows.Count, 1).End(xlUp).Offset(-7, 1).Resize(8).Calculate
    End If
End Sub
[/vba]
К сообщению приложен файл: 3022237.xlsm(20.6 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Среда, 13.02.2019, 18:39
 
Ответить
Сообщениееще вариант, формульный
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("строка")-СТРОКА(Таблица2)+1;1)
Код
=ТРАНСП(ИНДЕКС(Таблица1[[Адрес склада]:[Телефон]];ПОИСКПОЗ(B9;Таблица1[Название организации];);))
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("row")-СТРОКА(Таблица2)+1;ОКРВВЕРХ(ЯЧЕЙКА("col")-1;3))
Код
=ИНДЕКС(Таблица2;ЯЧЕЙКА("row")-СТРОКА(Таблица2)+1;ОКРВВЕРХ(ЯЧЕЙКА("col")-1;3)+1)

и макрос для пересчета формул
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, [Таблица2]) Is Nothing And Target.Count = 1 Then
        Cells(Rows.Count, 1).End(xlUp).Offset(-7, 1).Resize(8).Calculate
    End If
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 13.02.2019 в 18:35
Мир MS Excel » Вопросы и решения » Вопросы по VBA » При нажатии на ячейку заполняем таблицу данными (Worksheet_SelectionChange)
  • Страница 1 из 1
  • 1
Поиск:

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