16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
1

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

11.12.2015, 14:52. Показов 3768. Ответов 34
Метки нет (Все метки)

Всем добрый день. Есть такая не сложная задача:
Найти столбец содержащий в первой строке слово "маршрут", в нём искать регулярные выражения как 3000,3100,3200,3300,3400,3600,3800,3801,2400 и справа от столбца с "маршрут" создать столбец "пришёл" в котором будем писать если нашлось 3000, то пишем 3000,если нет 3000, но нашлось 3100 то пишем 3100 и тд до последней записи в файле.
Как это все реализовать?Помогите пожалуйста!
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
1
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
11.12.2015, 14:52
Ответы с готовыми решениями:

Печать Штрих-кода в соседнем столбце
Добрый день! Нужна ваша помощь! Существует бланк по которому администратор выполняет...

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

При значении ячеек в столбце А присвоить определенное значение ячейкам в столбце B
Столкнулся с тем, что мне нужно при значении ячеек в столбце А присвоить определенное значение...

Как объединить ячейки во втором столбце при совпадении значений в первом столбце
Здравствуйте. Помогите плиз. В таблице есть повторяющиеся значения в первом столбце (код товара)...

34
15131 / 6405 / 1730
Регистрация: 24.09.2011
Сообщений: 9,999
11.12.2015, 15:14 2
blackeangel, искать по совпадению, т.е. ячейка должна содержать число 3000 или 3100, или по вхождению, например "цена билета 3200р"?
Лучше файл-пример приложите.
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
11.12.2015, 15:25  [ТС] 3
Вот пример во вложении как должно получиться.
Думал взять из поиск и удаление строки по шаблону,но не сообразил как при крутить столько условий
Вложения
Тип файла: xlsx primer.xlsx (9.0 Кб, 8 просмотров)
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
11.12.2015, 23:13  [ТС] 4
Казанский, Вот пример до и после как должно получиться, чтоб понятнее было...и искать по вхождению. .
Вложения
Тип файла: xlsx primer2.xlsx (7.5 Кб, 14 просмотров)
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
13.12.2015, 16:37  [ТС] 5
Казанский, часть можно взять отсюда
Определение первого слова в ячейке Excel
А другую часть отсюда
http://macros-vba.ru/makrosy/e... ov-v-excel
И как то их соединить...

Добавлено через 43 минуты
себе представляю это так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
sub типа пример ()
задаем переменные
а=3000
b=3100
c=3200
d=3300
...
ищем столбец содержащий в первой строке "Маршрут"
Получаем его номер
дальше запускаем for со 2 до последней строки содержащей запись в столбце с "Маршрут"
запускаем if содержит(входит) а then
в столбец с номером "Маршрут" +1 и строка [i] пишем константу а
else
 if содержит(входит) b then
в столбец с номером "Маршрут" +1 и строка [i] пишем константу b
 else
     if содержит(входит) c then
в столбец с номером "Маршрут" +1 и строка [i] пишем константу c
     else
... 
end if
end sub
но как это реализовать на ЯП не знаю...
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
14.12.2015, 07:22  [ТС] 6
Вот ещё один пример,если он поможет.Как было и как должно быть на разных листах
Вложения
Тип файла: xlsx пример.xlsx (17.0 Кб, 18 просмотров)
0
18 / 19 / 5
Регистрация: 14.09.2015
Сообщений: 104
14.12.2015, 11:28 7
пока для начала вот так...
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Find01()
Application.ScreenUpdating = False
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column ' определяем столбец ячейки
MsgBox ("Номер столбца Маршрут" & ncolumn)
i = 2
Do While Cells(i, ncolumn).Value <> Empty
'Cells(i, ncolumn + 1).Value =условия подстановки
i = i + 1
Loop
Application.ScreenUpdating = True
End Sub
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
14.12.2015, 14:44  [ТС] 8
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
Sub raspil()
Dim A As String, B As String, C As String, D As String, E As String, F As String, G As String, H As String
Application.ScreenUpdating = False
A = "3200"
B = "3000"
C = "3100"
D = "3400"
E = "3300"
F = "3800"
G = "3801"
H = "2400"
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column ' определяем столбец ячейки
MsgBox ("Номер столбца Маршрут" & ncolumn)
i = 2
Do While Cells(i, ncolumn).Value <> Empty
 
If Cell Like A Then
    Cells(i, ncolumn + 1).Value = A
    Else
        If Cell Like B Then
        Cells(i, ncolumn + 1).Value = B
    Else
        If Cell Like C Then
        Cells(i, ncolumn + 1).Value = C
            Else
        If Cell Like D Then
        Cells(i, ncolumn + 1).Value = D
            Else
        If Cell Like E Then
        Cells(i, ncolumn + 1).Value = E
            Else
        If Cell Like F Then
        Cells(i, ncolumn + 1).Value = F
            Else
        If Cell Like G Then
        Cells(i, ncolumn + 1).Value = G
            Else
        If Cell Like H Then
        Cells(i, ncolumn + 1).Value = H
 
    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
Не заработало...

Добавлено через 23 минуты
А вот отсюда что можно стырить?:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Udalenie_Strok_Po_Shablonu()
    Dim r As Long, FirstRow As Long, LastRow As Long
    Dim Region As Range, iRow As Range, Cell As Range
    Dim Shablon As String
 
    Shablon = "здесь вводится искомый текст"
 
    Set Region = ActiveSheet.UsedRange
    FirstRow = Region.Row
    LastRow = Region.Row - 1 + Region.Rows.Count 
        For r = LastRow To FirstRow Step -1
        Set iRow = Region.Rows(r - FirstRow + 1)
            For Each Cell In iRow.Cells
                If Cell Like Shablon Then
                    Rows(r).Delete
                End If
            Next Cell
        Next r
End Sub
0
18 / 19 / 5
Регистрация: 14.09.2015
Сообщений: 104
14.12.2015, 15:14 9
Лучший ответ Сообщение было отмечено blackeangel как решение

Решение

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
Sub Find01()
Dim A1 As String, B As String, C As String, D As String, E As String, F As String, G As String, H As String
Application.ScreenUpdating = False
i = 2
sWhatFind = "Ìàðøðóò"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column ' îïðåäåëÿåì ñòîëáåö ÿ÷åéêè
MsgBox ("Íîìåð ñòîëáöà Ìàðøðóò" & ncolumn)
A = Cells(i, ncolumn).Value
Do While Cells(i, ncolumn).Value <> Empty
'Cells(i, ncolumn + 1).Value = åñëè((Find("3000", Cells(i, ncolumn), 1) > 0) = 2, "3000", "")
If Cells(i, ncolumn).Value Like "*3000*" Then
    Cells(i, ncolumn + 1).Value = "3000"
    Else
        If Cells(i, ncolumn).Value Like "*3100*" Then
        Cells(i, ncolumn + 1).Value = "3100"
    Else
        If Cells(i, ncolumn).Value Like "*3200*" Then
        Cells(i, ncolumn + 1).Value = "3200"
            Else
        If Cells(i, ncolumn).Value Like "*3300*" Then
        Cells(i, ncolumn + 1).Value = "3300"
            Else
        If Cells(i, ncolumn).Value Like "*3400*" Then
        Cells(i, ncolumn + 1).Value = "3400"
        Else
         If Cells(i, ncolumn).Value Like "*3600*" Then
        Cells(i, ncolumn + 1).Value = "3600"
            Else
        If Cells(i, ncolumn).Value Like "*3800*" Then
        Cells(i, ncolumn + 1).Value = "3800"
            Else
        If Cells(i, ncolumn).Value Like "*3801*" Then
        Cells(i, ncolumn + 1).Value = "3801"
            Else
        If Cells(i, ncolumn).Value Like "*2400*" Then
        Cells(i, ncolumn + 1).Value = "2400"
 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
Добавлено через 15 минут
..забыл мусор поудалять ))
1
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
14.12.2015, 15:33  [ТС] 10
eritik, тогда Dim можно закоментить.
И ещё что за кракозябры?

Добавлено через 5 минут
eritik,И почему от констант ушёл?
0
18 / 19 / 5
Регистрация: 14.09.2015
Сообщений: 104
14.12.2015, 15:52 11
кузебряки - это русский текст; пока перемещал между удаленными ПК -потерял исходное форматирование(
мне было проще без констант.
DIM и A = Cells(i, ncolumn).Value можно так же закоментить или удалить.
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
15.12.2015, 07:35  [ТС] 12
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
Sub raspil()
Application.ScreenUpdating = False
i = 2
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
Do While Cells(i, ncolumn).Value <> Empty
If Cells(i, ncolumn).Value Like "*3000*" Then
Cells(i, ncolumn + 1).Value = "3000"
Else
If Cells(i, ncolumn).Value Like "*3100*" Then
Cells(i, ncolumn + 1).Value = "3100"
Else
If Cells(i, ncolumn).Value Like "*3200*" Then
Cells(i, ncolumn + 1).Value = "3200"
Else
If Cells(i, ncolumn).Value Like "*3300*" Then
Cells(i, ncolumn + 1).Value = "3300"
Else
If Cells(i, ncolumn).Value Like "*3400*" Then
Cells(i, ncolumn + 1).Value = "3400"
Else
If Cells(i, ncolumn).Value Like "*3600*" Then
Cells(i, ncolumn + 1).Value = "3600"
Else
If Cells(i, ncolumn).Value Like "*3800*" Then
Cells(i, ncolumn + 1).Value = "3800"
Else
If Cells(i, ncolumn).Value Like "*3801*" Then
Cells(i, ncolumn + 1).Value = "3801"
Else
If Cells(i, ncolumn).Value Like "*2400*" Then
Cells(i, ncolumn + 1).Value = "2400"
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
Ругается на ошибку
Can't execute code in break mode
0
18 / 19 / 5
Регистрация: 14.09.2015
Сообщений: 104
15.12.2015, 07:55 13
все отлично работает.
оставнови выполнение макроса "reset" и запусти заново.
1
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
15.12.2015, 08:14  [ТС] 14
eritik, прошу прощения за накат,надо было Эксель перезапустить)))
0
15131 / 6405 / 1730
Регистрация: 24.09.2011
Сообщений: 9,999
15.12.2015, 15:51 15
blackeangel, eritik, ну вы даете Про массивы, циклы слышали?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub raspil()
Application.ScreenUpdating = False
i = 2
Dim v$(): v = Split("3000,3100,3200,3300,3400,3600,3800,3801,2400", ",")
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
Do While Cells(i, ncolumn).Value <> Empty
  s = Cells(i, ncolumn).Text
  For Each x In v
    If InStr(s, x) Then
      Cells(i, ncolumn + 1).Value = x
      Exit For
    End If
  Next
  i = i + 1
Loop
Application.ScreenUpdating = True
End Sub
Добавлено через 33 минуты
blackeangel, так в соотв. с ТЗ - вставка столбца, т.е. данные справа от ст. Маршрут не будут затерты.
Заголовок не обязан быть в первой строке.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub blackeangel()
 
Const HDR1 = "Маршрут"
Const HDR2 = "Пришёл"
Const SPIS = "3000,3100,3200,3300,3400,3600,3800,3801,2400" 'список ЧИСЕЛ через запятую
  'если нужно включить в список нечисловое значение, его надо заключить в ДВОЙНЫЕ кавычки,
  'например "3000,3100,""3900a"",2500"
 
Dim x As Range
Set x = Cells.Find(What:=HDR1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If x Is Nothing Then
  MsgBox "Заголовок '" & HDR1 & "' не найден", vbExclamation
  Exit Sub
End If
Columns(x.Column + 1).Insert
x.Offset(, 1) = HDR2
With Range(x.Offset(1), Cells(Rows.Count, x.Column).End(xlUp)).Offset(, 1)
  .FormulaR1C1 = "=INDEX({" & SPIS & "},MATCH(1,SEARCH(""*""&{" & SPIS & "}&""*"",RC[-1]),))"
  .Value = .Value
End With
End Sub
1
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
15.12.2015, 15:58  [ТС] 16
Казанский, это хорошо когда числиное значение надо подставить,а когда надо согласовать 2 массива?потому что цифры согласуются с словами. То ьишь согласно твоему коду надо брать ещё один массив и как то его согласовывать с этим.Т.к. 3100 это ЭМЦ к примеру. В этом коде на подстановку я заменил на буквы,а поиск выполняется по цифрам.Одним массивом сия невозможно.

Добавлено через 5 минут
У меня сделано так и все работает
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
Sub raspil()
Application.ScreenUpdating = False
i = 2
sWhatFind = "Маршрут"
Cells.Find(What:=sWhatFind, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
ncolumn = ActiveCell.Column
    Columns(ncolumn + 1).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, ncolumn + 1).Value = "ЦЕХ"
Do While Cells(i, ncolumn).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 = "БИХ"
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
Согласно ТЗ и вставляет столбец и имя ему задаёт и тд
0
15131 / 6405 / 1730
Регистрация: 24.09.2011
Сообщений: 9,999
15.12.2015, 16:00 17
blackeangel, то есть ищем одно, а в столбец записываем другое (соответствующее)? Это можно и с одним массивом, но удобнее и логичнее с двумя отдельными. И с циклом, и с формулой - там в формуле первый SPIS - что записывать, второй SPIS - что искать.
0
16 / 7 / 1
Регистрация: 22.07.2015
Сообщений: 759
15.12.2015, 16:23  [ТС] 18
Казанский, для меня это сложно уже.Особенно если учесть что последний раз что то прогил 6 лет назад и то на паскале)))
А для интересного и сложного есть мною созданная тема
Сложная задача по поиску и вхождению
А в формуле так и не понял где там те значения что вставляются,и как 2масива завязать...

Добавлено через 16 минут
Или вот ещё тема интересная для вас
Поиск процесса через vba
0
15131 / 6405 / 1730
Регистрация: 24.09.2011
Сообщений: 9,999
15.12.2015, 16:26 19
Лучший ответ Сообщение было отмечено blackeangel как решение

Решение

blackeangel,
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub blackeangel()
 
Const HDR1 = "Маршрут"
Const HDR2 = "ЦЕХ"
Const SPIS = "3200,3000,3600,3100,3400,3300,3800,3801,2400" 'список искомых через запятую
Const TSEH = "ЦВО,ЭМЦ,ПММ,СМЦ,МЦ,ЦКМ,ОВК,ОВК,БИХ" 'список подставляемых через запятую
 
Dim x As Range
Set x = Cells.Find(What:=HDR1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If x Is Nothing Then
  MsgBox "Заголовок '" & HDR1 & "' не найден", vbExclamation
  Exit Sub
End If
Columns(x.Column + 1).Insert
x.Offset(, 1) = HDR2
With Range(x.Offset(1), Cells(Rows.Count, x.Column).End(xlUp)).Offset(, 1)
  .FormulaR1C1 = "=INDEX({""" & Replace(TSEH, ",", """,""") & """},MATCH(1,SEARCH(""*""&{""" & Replace(SPIS, ",", """,""") & """}&""*"",RC[-1]),))"
  .Value = .Value 'закомментируйте, чтобы оставить на листе формулы
End With
End Sub
1
18 / 19 / 5
Регистрация: 14.09.2015
Сообщений: 104
15.12.2015, 19:08 20
Цитата Сообщение от Казанский Посмотреть сообщение
eritik, ну вы даете Про массивы, циклы слышали?
кто это? что это?
я за vba сел пару месяцев назад ((...по необходимости..пока вот вникаю. разбираюсь и учусь вот на таких задачках.
массивы пока "темный лес"
спасибо за подсказку по упрощению.
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
15.12.2015, 19:08
Помогаю со студенческими работами здесь

Как найти в столбце А значение, если удовлетворяет критериям то в столбце Б пишем результат
Здравствуйте! Всем отличных выходных!!! Помогите, если не сложно. Большой Квадрат - ЕСЛИ...

Как выделить цветом значения в столбце, которые содержатся в другом столбце другого листа
Как выделить цветом значения в столбце , которые содержатся в другом столбце другого листа ?

Осуществить протягивание значений в одном столбце до строки последней заполненной ячейки в другом столбце
Доброго времени суток! Нужна помощь... Есть такая не тривиальная задача которую я даже не...

Выделить ячейку с числом во втором столбце, если данное число есть также в первом столбце
День добрый,подскажите пожалуйста... на листе экселя есть 2 столбца с числами,как сделать так...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru