Поиск фразы в столбце и создание записи в соседнем столбце

@blackeangel · Регистрация: 22.07.2015

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

Всем добрый день. Есть такая не сложная задача:
Найти столбец содержащий в первой строке слово "маршрут", в нём искать регулярные выражения как 3000,3100,3200,3300,3400,3600,3800,3801, 2400 и справа от столбца с "маршрут" создать столбец "пришёл" в котором будем писать если нашлось 3000, то пишем 3000,если нет 3000, но нашлось 3100 то пишем 3100 и тд до последней записи в файле.
Как это все реализовать?Помогите пожалуйста!

@blackeangel · 16.12.2015, 12:30 **[ТС]**

В обоих случаях прекращает работу если в поле маршрут пусто, а в других колонках есть записи ..как решить сия мелкое недоразумение?

Visual Basic
1
Do While Cells(i, ncolumn).Value <> Empty

На

Visual Basic
1
Do While Cells(i, 1).Value <> Empty

Временно заменил на 1 столбец

@eritik · 16.12.2015, 13:28

все верно... ведь:
HDR1="Маршрут"
"Cells.Find(What:=HDR1".. =0, т.е. ничего не найдено.

@blackeangel · 16.12.2015, 14:36 **[ТС]**

eritik, поэтому пришлось отказаться от массивов и запилить по старому привязавшись к другому столбцу

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
Sub raspil()
Application.ScreenUpdating = False
i = 2
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
sWhatFind2 = "Обозначение"
Cells.Find(What:=sWhatFind2, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn2 = ActiveCell.Column
    Columns(ncolumn + 1).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, ncolumn + 1).Value = "ЦЕХ"
Do While Cells(i, ncolumn2).Value <> Empty
If Cells(i, ncolumn).Value Like "*3200*" Then
Cells(i, ncolumn + 1).Value = "ЦВО"
Else
If Cells(i, ncolumn).Value Like "*3000*" Then
Cells(i, ncolumn + 1).Value = "ЭМЦ"
Else
If Cells(i, ncolumn).Value Like "*3600*" Then
Cells(i, ncolumn + 1).Value = "ПММ"
Else
If Cells(i, ncolumn).Value Like "*3100*" Then
Cells(i, ncolumn + 1).Value = "СМЦ"
Else
If Cells(i, ncolumn).Value Like "*3400*" Then
Cells(i, ncolumn + 1).Value = "МЦ"
Else
If Cells(i, ncolumn).Value Like "*3300*" Then
Cells(i, ncolumn + 1).Value = "ЦКМ"
Else
If Cells(i, ncolumn).Value Like "*3800*" Then
Cells(i, ncolumn + 1).Value = "ОВК"
Else
If Cells(i, ncolumn).Value Like "*3801*" Then
Cells(i, ncolumn + 1).Value = "ОВК"
Else
If Cells(i, ncolumn).Value Like "*2400*" Then
Cells(i, ncolumn + 1).Value = "БИХ"
Else
If IsEmpty(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "Без МЦМ"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

Добавлено через 9 минут
А давайте ещё условие поставим если есть кроме "маршрут" "маршрут общий". Если есть "маршрут общий" то берём его,если нет то "маршрут"

Добавлено через 26 минут
Или если есть и "маршрут" и "маршрут общий",то отдать предпочтение "маршрут общий"

@eritik · 16.12.2015, 14:47

можно вот так попробывать:

Visual Basic
1
2
3
4
5
On Error Resume Next
Dim x As Range
   Set x = Cells.Find(What:="маршрут общий", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
    x.Activate
    If x Is Nothing Then

....и запускаем второй вариант поиска
...либо через массив, но тут пока я не смогу помочь..((

@blackeangel · 16.12.2015, 15:04 **[ТС]**

eritik, вот минуту назад так же сделал и получил 91 ошибку

Вот код,может где не так записал...

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
Sub raspil()
Application.ScreenUpdating = False
i = 2
sWhatFind = "Маршрут"
sWhatFind2 = "Обозначение"
sWhatFind3 = "Маршрут общий"
Cells.Find(What:=sWhatFind2, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn2 = ActiveCell.Column
Cells.Find(What:=sWhatFind3, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
If ncolumn Is Nothing Then ' если нет "Маршрут общий", то берем "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
End If
Columns(ncolumn + 1).Insert 'вставляем столбец справа
Cells(1, ncolumn + 1).Value = "ЦЕХ" 'вставляем заголовок столбца
' гоняем цикл пока в "Обозначение" не пустая ячейка-->
Do While Cells(i, ncolumn2).Value <> Empty 'поставил на "Обозначение" т.к. обрывался на пустой ячейке
' <--
If Cells(i, ncolumn).Value Like "*3200*" Then
Cells(i, ncolumn + 1).Value = "ЦВО"
Else
If Cells(i, ncolumn).Value Like "*3000*" Then
Cells(i, ncolumn + 1).Value = "ЭМЦ"
Else
If Cells(i, ncolumn).Value Like "*3600*" Then
Cells(i, ncolumn + 1).Value = "ПММ"
Else
If Cells(i, ncolumn).Value Like "*3100*" Then
Cells(i, ncolumn + 1).Value = "СМЦ"
Else
If Cells(i, ncolumn).Value Like "*3400*" Then
Cells(i, ncolumn + 1).Value = "МЦ"
Else
If Cells(i, ncolumn).Value Like "*3300*" Then
Cells(i, ncolumn + 1).Value = "ЦКМ"
Else
If Cells(i, ncolumn).Value Like "*3800*" Then
Cells(i, ncolumn + 1).Value = "ОВК"
Else
If Cells(i, ncolumn).Value Like "*3801*" Then
Cells(i, ncolumn + 1).Value = "ОВК"
Else
If Cells(i, ncolumn).Value Like "*2400*" Then
Cells(i, ncolumn + 1).Value = "БИХ"
Else
If IsEmpty(Cells(i, ncolumn).Value) = True Then
Cells(i, ncolumn + 1).Value = "Без МЦМ"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub

@eritik · 17.12.2015, 07:03

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

eritik, вот минуту назад так же сделал и получил 91 ошибку

отсутствуют объекты поиска
выложи итоговый файл

@blackeangel · 17.12.2015, 07:25 **[ТС]**

eritik, да я в надстройку запилил...

@blackeangel · 17.12.2015, 07:33 **[ТС]**

Вот пример

@blackeangel · 17.12.2015, 07:34 **[ТС]**

Сначала запускаемых raspil,а потом копия, ну и столбец добавить маршрут общий скопированы его с маршрут...а то забыл добавить

@blackeangel · 17.12.2015, 15:22 **[ТС]**

eritik,исправоеный пример с нерабочим макросом(91 ошибка). Сначала запускаем raspil,а потом копия.Там в надстройках будет кнопка,вот жми на неё...

@blackeangel · 17.12.2015, 16:10 **[ТС]**

сегодня ругается на 424 ошибку и выделяет

Visual Basic
1
If ncolumn Is Nothing Then

@eritik · 17.12.2015, 17:17

blackeangel, получилось вот в таком варианте:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub raspil()
Application.ScreenUpdating = False
i = 2
sWhatFind = "Маршрут"
sWhatFind2 = "Обозначение"
sWhatFind3 = "Маршрут общий"
Cells.Find(What:=sWhatFind2, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn2 = ActiveCell.Column
 
 
 
On Error Resume Next
If Cells.Find(What:=sWhatFind3, After:=ActiveCell, SearchOrder:=xlByColumns).Activate = Error Then ' если нет "Маршрут общий", то берем "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
End If
ncolumn = ActiveCell.Column

т.е. если условие поиска выдаст ошибку, то переходим к следующему условия поиска
on error Resume next - для того чтобы при ошибке не становился макрос

@blackeangel · 17.12.2015, 17:31 **[ТС]**

eritik, здесь чего то не хватает из логического соображения.это условие пойдёт если нет маршрут общий,но не пойдёт если есть и тот маршрут и другой,при данном коде он пройдёт где просто "маршрут" или я что то путаю?

@eritik · 17.12.2015, 17:43

просто проверь

Добавлено через 2 минуты
если при поиске "маршрут общий" ошибка, то переходим к поиске "маршрут"
закрываем цикл и только потом обозначаем ncolumn = ActiveCell.Column

@blackeangel · 18.12.2015, 07:46 **[ТС]**

eritik, завтра обязательно проверю и отпишусь

Добавлено через 13 часов 57 минут
eritik, спасибо, все работает

хотя для меня все равно не понятно как

Новые блоги и статьи Все статьи Все блоги /
Как у меня протекала болезнь zorxor 27.08.2026 Здравствуйте, друзья! Эта запись блога предназначена именно для вас - для моих дорогих друзей, которые знали меня лично. Чтобы ответить на вопрос - а что же со мной произошло на самом деле? Я учился. . .	Нашел вот забавное видео о измерениях. Лучшее что я видел на эту тему kumehtar 26.08.2026 ILETXiw9bMQ Основная суть и тезисы по измерениям: 0D (Нулевое измерение): точка, не имеющая длины, ширины, высоты или объема. Объект не может перемещаться в 0D. 1D (Первое измерение):. . .	[EasyBuilder Pro] Памятка по разработке для панелей Weintek ФедосеевПавел 26.08.2026 Памятка по разработке для панелей Weintek ВВЕДЕНИЕ Ранее, при реализации проектов основное внимание уделял разработке управляющей программы для контроллера, а панели оператора доставалось время. . .	Модель по догадкам anaschu 25.08.2026 Прошло две недели. Я уже рассказывал, как разговаривал с сотрудниками у сортировки и как понял, что главная ветка — не про приёмку, а про отбор. Но тогда я думал, что понял механику. На этой неделе я. . .
Запись в регистр сведений независимо от заполненности табличной части Maks 25.08.2026 Реализация из решения ниже выполнена на нетиповом документе с несколькими табличными частями, разработанного в КА2. Задача: Обеспечить запись документа в регистр сведений независимо от. . .	Ноутбук Альфария kumehtar 24.08.2026 Встретился тут в сети ноутбук Альфария, примарха Альфа-Легиона. Хотя возможно, это ноутбук Омегона, разумеется. Ну как вам?	Мастера простых решений DevAlt 23.08.2026 В сишарп стэках winforms, да и wpf существует сложная система связывания источниках данных и элементов формы(текстовые поля и метки), опирается все это на технологию событий и мета. . .	Цена ошибки DevAlt 23.08.2026 Человек я беспокойный и потому заинтересовался OCaml, в чате форсили функторы модулей как суперфичу. Пытаясь отдуплить концепт, наткнулся на тутор с простым примером. А главный принцип обучения от. . .

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908

	Поиск фразы в столбце и создание записи в соседнем столбце 11.12.2015, 14:52. Показов 5455. Ответов 34 Метки нет (Все метки) Всем добрый день. Есть такая не сложная задача: Найти столбец содержащий в первой строке слово "маршрут", в нём искать регулярные выражения как 3000,3100,3200,3300,3400,3600,3800,3801, 2400 и справа от столбца с "маршрут" создать столбец "пришёл" в котором будем писать если нашлось 3000, то пишем 3000,если нет 3000, но нашлось 3100 то пишем 3100 и тд до последней записи в файле. Как это все реализовать?Помогите пожалуйста! 1

@eritik 18 / 19 / 5 Регистрация: 14.09.2015 Сообщений: 104
	16.12.2015, 13:28
	все верно... ведь: HDR1="Маршрут" "Cells.Find(What:=HDR1".. =0, т.е. ничего не найдено. 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	17.12.2015, 07:25 [ТС]
	eritik, да я в надстройку запилил... 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	17.12.2015, 07:34 [ТС]
	Сначала запускаемых raspil,а потом копия, ну и столбец добавить маршрут общий скопированы его с маршрут...а то забыл добавить 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	17.12.2015, 17:31 [ТС]
	eritik, здесь чего то не хватает из логического соображения.это условие пойдёт если нет маршрут общий,но не пойдёт если есть и тот маршрут и другой,при данном коде он пройдёт где просто "маршрут" или я что то путаю? 0

@eritik 18 / 19 / 5 Регистрация: 14.09.2015 Сообщений: 104
	17.12.2015, 17:43
	просто проверь Добавлено через 2 минуты если при поиске "маршрут общий" ошибка, то переходим к поиске "маршрут" закрываем цикл и только потом обозначаем ncolumn = ActiveCell.Column 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	18.12.2015, 07:46 [ТС]
	eritik, завтра обязательно проверю и отпишусь Добавлено через 13 часов 57 минут eritik, спасибо, все работает хотя для меня все равно не понятно как 0

Поиск фразы в столбце и создание записи в соседнем столбце

Решение