Добрый вечер знатоки. Обращаюсь за помощью, так как остановился на конечном этапе. А именно-выгрузка значений из таблицы в виде суммы на лист в другую книгу. Пример прилагаю. Основной файл "Меню КОМПЛЕКС" Файл для загрузки значений Меню ***, Лист КОМПЛЕКС 180 В нём я вручную проставил данные для примера, что бы было понятно. С уважением.
Действительно, оказался пустой. Исправляю. Поменял в стартовом. В серых столбцах я указал номер строки из таблицы, соответствующий определенному пункту листа КОМПЛЕКС. Примерно так и планировал вытягивать данные, но оказалось очень не удобно и при смещении строк всё нарушается. А в VBA не могу представить алгоритм работы.
Не очень понятно, что вы желаете получить на листе КОМПЛЕКС 180. Что на этом листе уже есть(столбцы A:D) и что нужно подтянуть( номера строк из Лист1 Меню КОМПЛЕКС в столбцы F:M) согласно блюдам и дням недели?
Kuzmich написал: и что нужно подтянуть( номера строк из Лист1 Меню КОМПЛЕКС в столбцы F:M) согласно блюдам и дням недели?
В F:M ничего подтягивать не нужно. Это я для примера выделил цветом и занёс номера для подсчета вручную. Нужны суммы соответствующих номеров блюд по каждому столбцу E, G, I, K,M и т.д. соответствующей даты из Таблица. Более конкретней описал в прилагаемом файле.
У вас есть книга Меню КОМПЛЕКС с двумя листами Таблица и Лист1. В Алгоритме выгрузки написано Ищем дату меню (столбец С), но там в обоих листах в столбце С ФИО пользователя. На какой лист ориентироваться? Таблица или Лист1? В книге Меню с 23.05.16 по 29.05.2016 (3) на листе КОМПЛЕКС 180 столбцы A:C уже заполнены? И надо найти количество вхождений каждого блюда в книге Меню КОМПЛЕКС за определенный день и эту цифру записать в ячейку столбца D? Так? У вас лист с названием Таблица вносит путаницу в ваши объяснения. В Excel все является таблицами. Пишите конкретно с какого листа какой книги брать данные.
Kuzmich написал: В Алгоритме выгрузки написано Ищем дату меню (столбец С), но там в обоих листах в столбце С ФИО пользователя
Ну конечно не в С а D. Ведь ищем дату. В алгоритме написано "Ищем дату 23.05.2016.
Цитата
Kuzmich написал: На какой лист ориентироваться? Таблица или Лист1?
Таблица. Лист 1 это уже я пробовал сделать сортировку по дате, на том всё и стало.
Цитата
Kuzmich написал: В книге Меню с 23.05.16 по 29.05.2016 (3) на листе КОМПЛЕКС 180 столбцы A:C уже заполнены? И надо найти количество вхождений каждого блюда в книге Меню КОМПЛЕКС за определенный день и эту цифру записать в ячейку столбца D? Так?
Да, так.
Цитата
Kuzmich написал: У вас лист с названием Таблица вносит путаницу в ваши объяснения. В Excel все является таблицами
Kuzmich написал: Возможна ли в вашей таблице переделка из горизонтального расположения в вертикальное?
Саму таблицу из Листа "Таблица" переделывать не стоит. Она идет с накоплением данных по неделям. И кол-во строк разрастется очень сильно. Для исключения этого я и создал свободный "Лист1", где отфильтровываю данные за последнюю неделю (в примере 23.05 по 27.05) из "Таблица". Вот её можно кромсать как угодно, хоть вертикально, хоть горизонтально. При следующей выгрузке данных в КОМПЛЕКС 180 она всё равно очистится, и будут занесены новые данные за следующую неделю. Кстати, столбцы А, B, C в принципе уже и не нужны. Главное-получить суммы номеров блюд.
№Второе 3 - 2(из К3:К4) в ячейку D28 (Количество строк с тройкой+1й гарнир (3,4)=2
И так далее за остальные даты. Сложность во Втором. Может быть Без гарнира, с Гарниром1 и Гарниром2, а может быть вообще без всего, как в ячейках D25, D30, D32.
На примере ранее выложенного листа КОМПЛЕКС 180 после запуска макроса получил цифры в столбце Е. Проверьте правильность. Данные получал из файла ТаблицаВертикально.xls
Макрос в модуль листа КОМПЛЕКС 180, сделать кнопку и привязать к ней макрос. Файл ТаблицаВертикально.xls тоже должен быть открыт
Код
Sub Menu()
Dim i As Integer
Dim iLastRow As Integer
Dim iDate As String
Dim Garnir1 As String
Dim Garnir2 As String
Dim Kompleks As Worksheet
Dim PosMenu As String
Dim FoundMenu As Range
Dim FAdr As String
Dim Kol_vo As Integer
Dim Kol_vo1 As Integer
Dim Kol_vo2 As Integer
Dim Wid As String
Dim Stolb As Integer
Application.ScreenUpdating = False
Set Kompleks = Workbooks("ТаблицаВертикально").Worksheets("Таблица")
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("E4:E" & iLastRow).ClearContents 'очистка диапазона
With Kompleks
For i = 2 To iLastRow
If InStr(1, Cells(i, 1), " ") = 0 Then 'это либо Салат, Первое и т.д
If Cells(i, 1).MergeArea.Count = 4 Then 'вид блюда
Wid = Cells(i, 1)
Select Case Wid 'выбор столбца для поиска
Case "Салат"
Stolb = 6
Case "Первое"
Stolb = 8
Case "Второе"
Stolb = 10
'Case "Гарнир"
' Stolb = 12
Case "Ещё гарнир"
Stolb = 14
End Select
End If
'если ячейка столбца В непустая и шрифт полужирный
If Cells(i, 2) <> "" And Cells(i, 2).Font.Bold = True Then
PosMenu = Cells(i, 2) 'позиция меню
'проверяем сколько позиций гарнира
If Cells(i, 1).MergeArea.Count = 3 Then 'три строки гарнира
Kol_vo = 0
Kol_vo1 = 0
Kol_vo2 = 0
Garnir1 = Cells(i + 1, 3)
Garnir2 = Cells(i + 2, 3)
'ищем позицию меню на листе Таблица
Set FoundMenu = .Columns(Stolb).Find(PosMenu, , xlValues, xlPart)
If Not FoundMenu Is Nothing Then 'нашли позицию
FAdr = FoundMenu.Address
Do
If .Cells(FoundMenu.Row, 4) = iDate Then 'соответствует дате
If .Cells(FoundMenu.Row, 12) = "" Then Kol_vo = Kol_vo + 1
If .Cells(FoundMenu.Row, 12) = Garnir1 Then Kol_vo1 = Kol_vo1 + 1
If .Cells(FoundMenu.Row, 12) = Garnir2 Then Kol_vo2 = Kol_vo2 + 1
End If
Set FoundMenu = .Columns(Stolb).FindNext(FoundMenu)
Loop While FoundMenu.Address <> FAdr
End If
Cells(i, 5) = Kol_vo
Cells(i + 1, 5) = Kol_vo1
Cells(i + 2, 5) = Kol_vo2
Else 'один гарнир
Kol_vo = 0
'ищем позицию меню на листе Таблица
Set FoundMenu = .Columns(Stolb).Find(PosMenu, , xlValues, xlPart)
If Not FoundMenu Is Nothing Then 'нашли позицию
FAdr = FoundMenu.Address
Do
If .Cells(FoundMenu.Row, 4) = iDate Then 'соответствует дате
Kol_vo = Kol_vo + 1
End If
Set FoundMenu = .Columns(Stolb).FindNext(FoundMenu)
Loop While FoundMenu.Address <> FAdr
End If
Cells(i, 5) = Kol_vo
End If
End If
Else 'в ячейке дата
iDate = Split(Cells(i, 1), " ")(1)
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Kuzmich написал: Макрос в модуль листа КОМПЛЕКС 180
Добрый день. Спасибо за Процедуру. Разбираюсь с кодом. Попробую перевести в изначальную задачу. А ушли от неё далеко. - Во-первых, создана ещё одна дополнительная книга ТаблицаВертикально, хотя, её роль может выполнять Лист1 в Меню КОМПЛЕКС. - Во-вторых, как вначале я писал - основная программа - это книга Меню КОМПЛЕКС. В ней уже есть запускающий модуль MenuOUT для выгрузки данных в книгу Меню "дата".Лист "КОМПЛЕКС 180". а вот эта книга еженедельно меняется. (приходит по эл. почте) и вставлять в неё макросы не очень удобно. - И было-бы хорошо увидеть процедуру переворачивания таблицы с горизонтального в вертикальное положение по датам. Заранее спасибо.
хорошо увидеть процедуру переворачивания таблицы с горизонтального в вертикальное положение по датам.
В модуль листа Таблица макрос, который на Лист1 переворачивает таблицу
Код
Sub TablitsaVertical()
Dim i As Integer
Dim iLastRow As Integer
Dim iLastRow1 As Integer
iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
With Worksheets("Лист1")
.Cells.Clear
Range("A1:N1").Copy
.Range("A1").PasteSpecial xlPasteColumnWidths
Range("A1:N" & iLastRow).Copy .Range("A1")
For i = 1 To 4
iLastRow1 = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
Range(Cells(1, 4 + 11 * i), Cells(iLastRow, 14 + 11 * i)).Copy .Cells(iLastRow1, 4)
Next
End With
End Sub