Уважаемые форумчане, не хватает мозгов помогите пожалуйста. С 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, отталкиваясь от него. Не знаю насколько понятно объяснил, проще понять на примере с файла:
Уважаемые форумчане, не хватает мозгов помогите пожалуйста. С 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
Glen, даже лучше, чем я просил) я думал насчет идеи использовать любую ячейку в макросе, но решил, что если тыкать не на цену, то собьется инфа в таблице и вместо производителя будет стоять цена, а вместо количества производитель, но вы сделали идеально, спасибо большое!
Glen, даже лучше, чем я просил) я думал насчет идеи использовать любую ячейку в макросе, но решил, что если тыкать не на цену, то собьется инфа в таблице и вместо производителя будет стоять цена, а вместо количества производитель, но вы сделали идеально, спасибо большое!BloOmer
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
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
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
