Цикл по нахождению строк с названиями и вставка в таблицу Word

@Superbochka · Регистрация: 04.12.2020

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

Здравствуйте, написал код по нахождению названий и их цифр в во всем документе для вставки в таблицу на первом листе (ввиде отчета). Но оптимизировать в виде цикла не могу сообразить, циклы не догоняю

.

Подробнее если, то есть Таблица на 1 листе ввиде отчета, ее нужно заполнить цифрами которые располагаются в документе на других листах(значение Pkl =), каждое название параметра присваивается определенная ее цифра. Одним словом мне нужно из документа найти эти цифры и вставить на первую страницу в таблицу в колонку "Контрольное, Рк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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
'1) Изменения для ДГДН в таблице
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "ДГДН"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    If Selection.Find.Execute Then
    Selection.Find.Execute
    
    With Selection.Find
        .Text = "Pkl  ="
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=11, Extend:=wdExtend
    Selection.Copy
    
     With Selection.Find
        .Text = "ДГДН"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.HomeKey Unit:=wdStory
    Else
    End If
'______________________________________________________________________________________________________________________________
    '2) Изменения для ДГПФ в таблице
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "ДГПФ"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    If Selection.Find.Execute Then
    Selection.Find.Execute
    
    With Selection.Find
        .Text = "Pkl  ="
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=11, Extend:=wdExtend
    Selection.Copy
    
     With Selection.Find
        .Text = "ДГПФ"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute
    
    Selection.MoveRight Unit:=wdCell
    Selection.MoveRight Unit:=wdCell
    
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.HomeKey Unit:=wdStory
    Else
    End If
'______________________________________________________________________________________________________________________________
    '3) Изменения для ДОПФ в таблице

и тд, слошником)

Добавлено через 6 минут
Еще такой момент, в самой таблице беру название параметра(их большой список), и ищу далее его в документе, где после нахожу значение 'Pkl='(для этого параметра), после копирую значение, возвращаюсь на 1 лист таблицы и вставляю в нужный параметр в столбец "Контрольное, Рк1"

@Superbochka · 20.08.2024, 15:14 **[ТС]**

shanemac51,
Добрый день, проверил ваш код, все работает, добавил некоторые правки для типов и 21 и 11 в этом моменте:

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
51
52
    
    For Each C1 In Selection.Cells
    s1 = Trim(C1.Range.Text)
    Debug.Print s1, "=="
    j1 = j1 + 1
    s1 = Replace(s1, Chr(13), "") & "=="
    s1 = Replace(s1, Chr(10), "")
    s1 = Replace(s1, Chr(7), "")
 
    [COLOR="darkorange"]If s1 Like "11[11А-Я]*" Then[/COLOR]
    s6 = "0"
    For j2 = 1 To Y1
    Debug.Print s1, j2, YM2(j2), YM6(j2)
    If s1 = YM2(j2) Then
    s6 = YM6(j2)
    Exit For
    End If
    Next j2
    Debug.Print s1, s6
    j1 = 0
    End If
    If j1 = 2 Then
    C1.Range.Text = s6
    End If
 
    Next C1
    
    For Each C2 In Selection.Cells
    s1 = Trim(C2.Range.Text)
    Debug.Print s1, "=="
    j1 = j1 + 1
    s1 = Replace(s1, Chr(13), "") & "=="
    s1 = Replace(s1, Chr(10), "")
    s1 = Replace(s1, Chr(7), "")
 
    [COLOR="darkorange"]If s1 Like "21[21А-Я]*" Then[/COLOR]
    s6 = "0"
    For j2 = 1 To Y1
    Debug.Print s1, j2, YM2(j2), YM6(j2)
    If s1 = YM2(j2) Then
    s6 = YM6(j2)
    Exit For
    End If
    Next j2
    Debug.Print s1, s6
    j1 = 0
    End If
    If j1 = 2 Then
    C2.Range.Text = s6
    End If
 
    Next C2

Но есть 1 нюанс о котором забыл, у другого типа бывают параметры безтипные, т. е. как например ДГПР, ДПВТ, КДШ1 и т д. С ними код не работает, он их просто пропускает, можно сделать чтобы и с ними выводились значения, или это уже трудно будет? P.s Пытался с кодом выше играться, но проиграл в этом вопросе.

shanemac51 · 20.08.2024, 15:46

Сообщение от Superbochka

Но есть 1 нюанс о котором забыл, у другого типа бывают параметры безтипные, т. е. как например ДГПР, ДПВТ, КДШ1 и т д. С ними код не работает, он их просто пропускает, можно сделать чтобы и с ними выводились значения, или это уже трудно будет? P.s Пытался с кодом выше играться, но проиграл в этом вопросе

сейчас смотреть некогда - вечером посмотрю

значит начало может быть не только 21*, но и 11* или любые 4 заглавные буквы
на 11 настроить просто

Visual Basic
1
2
If s1 Like "11[А-Я]*" or  s1 Like "21[А-Я]*" then
...

или даже

Visual Basic
1
2
If s1 Like "[0-9][0-9][А-Я]*" or  s1 Like "[А-Я][А-Я][А-Я]*" then
...

@Superbochka · 20.08.2024, 16:51 **[ТС]**

Попробую позже, благодарю

Новые блоги и статьи Все статьи Все блоги /
GitHub Copilot в JetBrains: модель по умолчанию, Fix и контроль MCP and_y87 12.10.2026 10 октября 2026 года GitHub обновил Copilot для JetBrains: добавил настройки стартовой модели, исправления из диагностики и управление автозапуском MCP. Поддержка IDE 2025. 1 прекращена — требуется. . .	GitHub Copilot в JetBrains: модель по умолчанию, Fix и контроль MCP and_y87 12.10.2026 10 октября 2026 года GitHub обновил Copilot для JetBrains: добавил настройки стартовой модели, исправления из диагностики и управление автозапуском MCP. Поддержка IDE 2025. 1 прекращена — требуется. . .	День 5 из 28: Codex подсказывает следующий запрос and_y87 12.10.2026 9 октября 2026 года OpenAI запустила бету Composer predictions — подсказок следующего сообщения в текущем диалоге Codex. Это помощь с формулировкой запроса, а не автоматическое продолжение задачи. . . .	Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .
ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .

@Superbochka 0 / 0 / 0 Регистрация: 04.12.2020 Сообщений: 75
	20.08.2024, 16:51 [ТС]
	Попробую позже, благодарю 0