Александр (Автор тем)

Поиск, подстановка данных по нескольким условиям с последующей фильтрацией повторяющихся строк

Пользователь

Сообщений: 18 Регистрация: 27.01.2015

Excel 2019

30.11.2022 10:57:53

Приветствую!

Помогите пожалуйста собрать формулу.
Каждый учитель сдает много раз аттестацию, надо убрать повторяющиеся строки, оставить максимальную, но самую крайнюю дату.
Значение дата и уровень при условии (лист "база" колонка L и R"):
1. Если ФИО, ранг из "ниже базового или базовый"- то Дата ближайшая к (=Сегодня) уровень "без диагностики"
1.1 Если ФИО, ранг из "ниже базового или (и) базовый, высокий или (и) экспертный"- то Дата ближайшая к (=Сегодня) по рангу "высокий или (и) экспертный"
1.2 Если ФИО, ранг из "высокий или (и) экспертный"- то Дата ближайшая к (=Сегодня) по рангу "экспертный"
1.3 Если ФИО, ранг из "экспертный" при дате 2018 и 2022 - то Дата ближайшая к (=Сегодня) по рангу "экспертный"
и2.1 Если ФИО, ранг из "процент выполнения" - то Дата ближайшая к (=Сегодня) как в условии №1
Уровень по уловию Процент выполнения
Ниже базового до 43
Базовый от 44 до 63
Высокий от 64 до 83
Экспертный от 84 до 100

Результат, лист "сортировка", при рабочей формуле применяется фильтр "высокий, экспертный" остается ровный список сотрудников по алфавиту.

Изменено: Александр - 30.11.2022 10:58:18

Перейти

VBA, выгрузка данных в шаблон Word (ограничение 255 символов)

Александр

Пользователь

Сообщений: 18 Регистрация: 27.01.2015

Excel 2019

07.11.2022 14:36:29

Друзья, программисты!

Код был взят с просторов интернета и адаптирован под свои задачи.
Код работает, но только для одной ячейки сняты ограничения. Еще обнаружил момент, в документе необходимо отобразить несколько раз одно и тоже значение из ячейки, данный код работает первый раз по порядку, далее остается код в word &значение.
Прошу подсказать (помочь), применительно к моим задачам, нужен код умеющий поддерживать текст больше 255 (ограничение 3584 для одной ячейки) символов в каждой ячейке, это в идеале (или примирительно к определенной ячейке) и с возможностью выгружать повторяющиеся данные.

Сразу оговорюсь, что не программист.
Образец документов приложил.

Код

Sub main()
Dim wdApp As Object
Dim wdDoc As Object

HomeDir$ = ThisWorkbook.Path
Set wdApp = CreateObject("Word.Application")
i% = 2
Do
If Cells(i%, 1).Value = "" Then Exit Do
If Cells(i%, 1).Value <> "" Then

Razdel$ = Cells(i%, 1).Text
NPP$ = Cells(i%, 2).Text
Name$ = Cells(i%, 3).Text
Job$ = Cells(i%, 4).Text
Axes$ = Cells(i%, 5).Text
Mark1$ = Cells(i%, 6).Text
Mark2$ = Cells(i%, 7).Text
Projectdoc$ = Cells(i%, 8).Text
Company$ = Cells(i%, 9).Text
Text$ = Cells(i%, 10).Text
DocID$ = Cells(i%, 11).Text
Date1$ = Cells(i%, 12).Text
Date2$ = Cells(i%, 13).Text
OnJob$ = Cells(i%, 14).Text
Add$ = Cells(i%, 15).Text
List$ = Cells(i%, 16).Text
Persname1$ = Cells(i%, 17).Text
Persname2$ = Cells(i%, 18).Text
Persname3$ = Cells(i%, 19).Text
Persname4$ = Cells(i%, 20).Text
Persname5$ = Cells(i%, 21).Text
PersFIO1$ = Cells(i%, 23).Text
PersFIO2$ = Cells(i%, 24).Text
PersFIO3$ = Cells(i%, 25).Text
PersFIO4$ = Cells(i%, 26).Text
PersFIO5$ = Cells(i%, 27).Text
PersPost1$ = Cells(i%, 29).Text
PersPost2$ = Cells(i%, 30).Text
PersPost3$ = Cells(i%, 31).Text
PersPost4$ = Cells(i%, 32).Text
PersPost5$ = Cells(i%, 33).Text
Acp$ = Cells(i%, 44).Text
Job2$ = Cells(i%, 45).Text
Blank1$ = Cells(i%, 47).Text
Blank2$ = Cells(i%, 48).Text
Blank3$ = Cells(i%, 49).Text
Blank4$ = Cells(i%, 50).Text
Gost$ = Cells(i%, 51).Text

FileCopy HomeDir$ + "\template.doc", HomeDir$ + "\" + NPP$ + ". " + Razdel$ + "_" + DataC$ + ".doc"
Set wdDoc = wdApp.Documents.Open(HomeDir$ + "\" + NPP$ + ". " + Razdel$ + "_" + DataC$ + ".doc")

On Error GoTo ErrorHandler

temp = Left(Text$, 255)
temp2 = Mid(Text$, 256, 255)
temp3 = Mid(Text$, 512, 255)
temp4 = Mid(Text$, 768, 255)
temp5 = Mid(Text$, 1024, 255)
temp6 = Mid(Text$, 1280, 255)
temp7 = Mid(Text$, 1536, 255)
temp8 = Mid(Text$, 1792, 255)
temp9 = Mid(Text$, 2048, 255)
temp10 = Mid(Text$, 2304, 255)
temp11 = Mid(Text$, 2560, 255)
temp12 = Mid(Text$, 2816, 255)
temp13 = Mid(Text$, 3072, 255)
temp14 = Mid(Text$, 3328, 255)
temp15 = Mid(Text$, 3584, 255)

wdDoc.Range.Find.Execute FindText:="&Razdel", ReplaceWith:=Razdel$
wdDoc.Range.Find.Execute FindText:="&NPP", ReplaceWith:=NPP$
wdDoc.Range.Find.Execute FindText:="&Name", ReplaceWith:=Name$
wdDoc.Range.Find.Execute FindText:="&Job", ReplaceWith:=Job$
wdDoc.Range.Find.Execute FindText:="&Axes", ReplaceWith:=Axes$
wdDoc.Range.Find.Execute FindText:="&Mark1", ReplaceWith:=Mark1$
wdDoc.Range.Find.Execute FindText:="&Mark2", ReplaceWith:=Mark2$
wdDoc.Range.Find.Execute FindText:="&Projectdoc", ReplaceWith:=Projectdoc$
wdDoc.Range.Find.Execute FindText:="&Company", ReplaceWith:=Company$

wdDoc.Range.Find.Execute FindText:="&Text", ReplaceWith:=temp
wdDoc.Range.Find.Execute FindText:="&Text2", ReplaceWith:=temp2
wdDoc.Range.Find.Execute FindText:="&Text3", ReplaceWith:=temp3
wdDoc.Range.Find.Execute FindText:="&Text4", ReplaceWith:=temp4
wdDoc.Range.Find.Execute FindText:="&Text5", ReplaceWith:=temp5
wdDoc.Range.Find.Execute FindText:="&Text6", ReplaceWith:=temp6
wdDoc.Range.Find.Execute FindText:="&Text7", ReplaceWith:=temp7
wdDoc.Range.Find.Execute FindText:="&Text8", ReplaceWith:=temp8
wdDoc.Range.Find.Execute FindText:="&Text9", ReplaceWith:=temp9
wdDoc.Range.Find.Execute FindText:="&Text10", ReplaceWith:=temp10
wdDoc.Range.Find.Execute FindText:="&Text11", ReplaceWith:=temp11
wdDoc.Range.Find.Execute FindText:="&Text12", ReplaceWith:=temp12
wdDoc.Range.Find.Execute FindText:="&Text13", ReplaceWith:=temp13
wdDoc.Range.Find.Execute FindText:="&Text14", ReplaceWith:=temp14
wdDoc.Range.Find.Execute FindText:="&Text15", ReplaceWith:=temp15

wdDoc.Range.Find.Execute FindText:="&DocID", ReplaceWith:=DocID$
wdDoc.Range.Find.Execute FindText:="&Date1", ReplaceWith:=Date1$
wdDoc.Range.Find.Execute FindText:="&Date2", ReplaceWith:=Date2$
wdDoc.Range.Find.Execute FindText:="&OnJob", ReplaceWith:=OnJob$
wdDoc.Range.Find.Execute FindText:="&Add", ReplaceWith:=Add$
wdDoc.Range.Find.Execute FindText:="&List", ReplaceWith:=List$
wdDoc.Range.Find.Execute FindText:="&Persname1", ReplaceWith:=Persname1$
wdDoc.Range.Find.Execute FindText:="&Persname2", ReplaceWith:=Persname2$
wdDoc.Range.Find.Execute FindText:="&Persname3", ReplaceWith:=Persname3$
wdDoc.Range.Find.Execute FindText:="&Persname4", ReplaceWith:=Persname4$
wdDoc.Range.Find.Execute FindText:="&Persname5", ReplaceWith:=Persname5$
wdDoc.Range.Find.Execute FindText:="&PersFIO1", ReplaceWith:=PersFIO1$
wdDoc.Range.Find.Execute FindText:="&PersFIO2", ReplaceWith:=PersFIO2$
wdDoc.Range.Find.Execute FindText:="&PersFIO3", ReplaceWith:=PersFIO3$
wdDoc.Range.Find.Execute FindText:="&PersFIO4", ReplaceWith:=PersFIO4$
wdDoc.Range.Find.Execute FindText:="&PersFIO5", ReplaceWith:=PersFIO5$
wdDoc.Range.Find.Execute FindText:="&PersPost1", ReplaceWith:=PersPost1$
wdDoc.Range.Find.Execute FindText:="&PersPost2", ReplaceWith:=PersPost2$
wdDoc.Range.Find.Execute FindText:="&PersPost3", ReplaceWith:=PersPost3$
wdDoc.Range.Find.Execute FindText:="&PersPost4", ReplaceWith:=PersPost4$
wdDoc.Range.Find.Execute FindText:="&PersPost5", ReplaceWith:=PersPost5$
wdDoc.Range.Find.Execute FindText:="&Acp", ReplaceWith:=Acp$
wdDoc.Range.Find.Execute FindText:="&Job2", ReplaceWith:=Job2$
wdDoc.Range.Find.Execute FindText:="&Blank1", ReplaceWith:=Blank1$
wdDoc.Range.Find.Execute FindText:="&Blank2", ReplaceWith:=Blank2$
wdDoc.Range.Find.Execute FindText:="&Blank3", ReplaceWith:=Blank3$
wdDoc.Range.Find.Execute FindText:="&Blank4", ReplaceWith:=Blank4$
wdDoc.Range.Find.Execute FindText:="&Gost", ReplaceWith:=Gost$

wdDoc.Save
wdDoc.Close
End If

i% = i% + 1
Loop
wdApp.Quit
MsgBox "Готово!"

Exit Sub
ErrorHandler:

wdDoc.Save
wdDoc.Close
wdApp.Quit

MsgBox "Не выполнено! " + Error

End Sub

Изменено: Александр - 09.11.2022 16:18:55

Перейти

Не выбирается ячейка другого файла, не присваивается ссылка после знака равенство

Александр

Пользователь

Сообщений: 18 Регистрация: 27.01.2015

Excel 2019

25.10.2022 16:09:58

Приветствую !!!

Помогите пожалуйста, что то произошло с программой или случайно отключил горячими клавишами.

Перестала работать простейшая функция, после знака равенства "=" не выбирается ячейка (данные) с другого файла, как прямая ссылка, так и в режиме формула.

При нажатии на ячейку происходит обычный просмотр, а не присваивание ссылки.

Сломал голову.

Ответа по поиску не нашел.

Изменено: Александр - 25.10.2022 16:10:52

Перейти

Поиск данных в диапазоне и подстановка в шаблон

Александр

Пользователь

Сообщений: 18 Регистрация: 27.01.2015

Excel 2019

13.11.2021 17:42:58

Добрый день!

Друзья, построил шаблон для выгрузки данных из общей таблицы в акты по направлению.
1. Общие данные берутся из таблицы "Таблица актов_3-я очередь_ 4-й этап_Школа"
2. Внутри "Таблица актов_3-я очередь_ 4-й этап_Школа" данные подгружаются во вкладки по направлению типа АСР_ВК1 .....
3. Подгрузка данных в основной шаблон "ВК1_Школа_АСР_тест, ВК2_Школа_АСР_тест ....."

- вкладка "ВК1_Школа_АСР_тест" выгрузка работает исправно;
- а вот во вкладке "ВК2_Школа_АСР_тест" в ячейке B56 выгрузка не идет, пробовал прописать другую формулу: =ЕСЛИОШИБКА(ВПР($D$20;'\\Asylbek\er-er пто\Немыкин\Новая папка\[Таблица актов_3-я очередь_ 4-й этап_Школа.xlsx]АСР_ОБЩ'!$B$4:$AQ$1004;42;0);"Не найдено")

Сломал голову, не работает!

Перейти