LOOK UP в vba + ФОРМУЛЫ

@rar · Регистрация: 04.02.2016

Студворк — интернет-сервис помощи студентам

Данный вопрос является продолжением к предыдущей темы "Как осуществить LOOK UP в VBA?" по ссылке:
Как осуществить LOOK UP в VBA?

Обращение прежде всего к уважаемому "KoGG",
Предыдущий макрос работает прекрасно. Сейчас требуется его доработать.
Файлы те же , но столбцы "шапки" некоторых из них дополнены:
В книге "Исходная таблица" (Лист 1) добавлены столбцы (веделены зеленым):
- "Площадь"; "Объем"; "Краска 1"; "Крыша:"

В книге "Таблица поиска" , лист "Мебель" добавлен столбец (выделен зеленым):
- "Краска 2".

Все указанные значения изначало заполнены и принимают следующие значения:
"Площадь" и "Объем" - размерность числа (должен быть 1 знак после запятой)
"Краска 1" , "Краска 2" и "Крыша" - могут принимать 3 значения: "True", "False", "" (пусто)

Алгоритм заполнения строк зависист от значений:
"Краска 1" , "Краска 2" и "Крыша"

Требуемы алгоритм проверки указанных значений:

ЕСЛИ "Краска 1" = "" (пусто)
ТО в книге "Итоги" в столбцы "Наименование" и "Краска" ничего не прописывается

аналогично,
ЕСЛИ "Краска 2" = "" (пусто)
ТО в книге "Итоги" в столбцы "Наименование" и "Краска" ничего не прописывается

ЕСЛИ "Краска 1" = "False"
ТО в книге "Итоги" в столбце "Наименование" и "Краска" прописываются соответствующие значения "Наименование" и "Краска" из таблицы книги "Исходная таблица" (как прописывалось в коде предыдущей темы)

аналогично,
ЕСЛИ "Краска 2" = "False"
ТО в книге "Итоги" в столбце "Наименование" и "Краска" прописываются соответствующие значения "Наименование" и "Краска" из таблицы книги "Исходная таблица" (как прописывалось в коде предыдущей темы)

ЕСЛИ "Краска 1" = "True"
ТО в книге "Итоги" в столбце "Наименование" и "Краска" значения записываются по другому принципу:

Смысл в том, что площадь должна разбиться на подплощади построчно

Сейчас приведу код VBA не относящийся именно к моему случаю, но примерно должно получится следующее:
Здесь для моего случая значения индексу строк и столбцов (Cells(rows, columns) должны соответствовать столбцам "Наименование" и "Краска"

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
     For i = 1 To lLastRow
 
Vпомещ = Cells(i, 1).Range(Cells(3, 2), Cells(3, 2)).Value 
'(Соответсвует значению "Объем" для моего случая)
Sn = Cells(i, 1).Range(Cells(2, 3), Cells(2, 3)).Value 
'(Соответсвует значению "Площадь" из файла "Исходная таблица" (Лист 1) для моего случая)
Sc = Cells(i, 1).Range(Cells(4, 3), Cells(4, 3)).Value
'(Соответсвует значению "Площадь" из файла "Исходная таблица" (Лист "Мебель") для моего случая)
hc = Vпомещ / Sn
avY = Sc / hc
hn = Sn / avY
avX = hc
 
If avX <= 2 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(avX * avY, 1)
End If
If avX - 2 > 0 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
 
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
 
End If
 
If avX - 4 > 0 Then
 
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
 
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
 
Cells(i, 1).Range(Cells(20, 1), Cells(20, 1)).Value = "подплощадь_3"
Cells(i, 1).Range(Cells(20, 3), Cells(20, 3)).Value = Application.RoundUp((avX - 4) * avY, 1)
 
End If
If avX - 6 > 0 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
Cells(i, 1).Range(Cells(20, 1), Cells(20, 1)).Value = "подплощадь_3"
Cells(i, 1).Range(Cells(20, 3), Cells(20, 3)).Value = Application.RoundUp((avX - 4) * avY, 1)
Cells(i, 1).Range(Cells(21, 1), Cells(21, 1)).Value = "подплощадь_4"
Cells(i, 1).Range(Cells(21, 3), Cells(21, 3)).Value = Application.RoundUp((avX - 6) * avY, 1)
End If
End If
Next

ЕСЛИ "Краска 2" = "True"
то аналогично выполняется вышеописанный алгоритм

Наконец,

ЕСЛИ "Краска 1" = "True" И ЕСЛИ "Краска 2" = "True"
то алгоритм учитывает суммарные значения площадей, и разбивает в свою очередь их на подплощади построчно,
и алгоритм выше примет вид:
ПРИМЕЧАНИЕ:
*Книга "Исходная таблица" / "Лист 1" МОЖЕТ ИМЕТЬ ТОЛЬКО ОДНУ СТРОКУ СО ЗНАЧЕНИЕМ "КРАСКА 1"
**Книга "Таблица поиска" / "Мебель" МОЖЕТ ИМЕТЬ НЕСКОЛЬКО СТРОК "КРАСКА 1" --В ЭТОМ СЛУЧАЕ СТРОКА НАИМЕНОВАНИЕ БУДЕТ ОБЩЕЕ "КРАСКА 1," А СТРОКИ С ЧИСЛОВЫМИ ЗНАЧЕНИЯМИ "ЦВЕТ" СКЛАДЫВАЮТСЯ:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 For i = 1 To lLastRow
Vпомещ = Cells(i, 1).Range(Cells(3, 2), Cells(3, 2)).Value 
'(Соответсвует значению "Объем" для моего случая)
Sn = Cells(i, 1).Range(Cells(2, 3), Cells(2, 3)).Value 
'(Соответсвует значению "Площадь" из файла "Исходная таблица" (Лист 1) для моего случая)
Sc = Cells(i, 1).Range(Cells(4, 3), Cells(4, 3)).Value
'(Соответсвует значению "Площадь" из файла "Исходная таблица" (Лист "Мебель") для моего случая)
hc = Vпомещ / Sn
avY = Sc / hc
hn = Sn / avY
avX = hc + hn
 
If avX <= 2 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(avX * avY, 1)
End If
If avX - 2 > 0 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
 
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
 
End If
 
If avX - 4 > 0 Then
 
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
 
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
 
Cells(i, 1).Range(Cells(20, 1), Cells(20, 1)).Value = "подплощадь_3"
Cells(i, 1).Range(Cells(20, 3), Cells(20, 3)).Value = Application.RoundUp((avX - 4) * avY, 1)
 
End If
If avX - 6 > 0 Then
Cells(i, 1).Range(Cells(18, 1), Cells(18, 1)).Value = "подплощадь_1"
Cells(i, 1).Range(Cells(18, 3), Cells(18, 3)).Value = Application.RoundUp(2 * avY, 1)
Cells(i, 1).Range(Cells(19, 1), Cells(19, 1)).Value = "подплощадь_2"
Cells(i, 1).Range(Cells(19, 3), Cells(19, 3)).Value = Application.RoundUp((avX - 2) * avY, 1)
Cells(i, 1).Range(Cells(20, 1), Cells(20, 1)).Value = "подплощадь_3"
Cells(i, 1).Range(Cells(20, 3), Cells(20, 3)).Value = Application.RoundUp((avX - 4) * avY, 1)
Cells(i, 1).Range(Cells(21, 1), Cells(21, 1)).Value = "подплощадь_4"
Cells(i, 1).Range(Cells(21, 3), Cells(21, 3)).Value = Application.RoundUp((avX - 6) * avY, 1)
End If
End If
Next

ЕСЛИ "Крыша" = "" (пусто) ИЛИ "Крыша"="False" ТО
ТО в книге "Итоги" в столбцы "Наименование" и "Краска" ничего не прописывается

ЕСЛИ "Крыша" = "True"
ТО в книге "Итоги" в строку "Наименование" заносится текст "Крыша", а в строки "Краска" численное значение площади.
Для наглядности в Таблице "Итоги" сведены все таблицы и показаны примеры требуемого расчета

*******То что должно получится в итоге выделено желтым в книге "Итоги"************

Новые блоги и статьи Все статьи Все блоги /
Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .	модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .
Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ	Дальние перспективы сервера - слоя сети с космологическим дизайном интефейса карты и логики. Hrethgir 07.04.2026 Дальнейшее ближайшее планирование вывело к размышлениям над дальними перспективами. И вот тут может быть даже будут нужны оценки специалистов, так как в дальних перспективах всё может очень сильно. . .	Горе от ума kumehtar 07.04.2026 Эта мне ментальная установка, что вот прямо сейчас, мол, мне для полного счастья не хватает (нужное вписать), и когда я этого достигну - тогда и полный кайф. Одна из самых сильных ловушек на пути. . . .