Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.89/64: Рейтинг темы: голосов - 64, средняя оценка - 4.89
1 / 1 / 0
Регистрация: 21.10.2012
Сообщений: 58
1

Удаление текста, следующего после определенного слова

21.10.2012, 14:13. Показов 11720. Ответов 10
Метки нет (Все метки)

Имеется столбец с данными. Нужно убрать весь текст после слова ТОО (в том числе и пробел, следующий сразу после слова ТОО).
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
21.10.2012, 14:13
Ответы с готовыми решениями:

Удаление текста до определенного слова
Здравствуйте. Помогите,пожалуйста написать следующий макрос: Имеется текст вида: Статья i. .......

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

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

Selection.Find поиск слова и копирование следующего слова
Здравствуйте! Я совсем новичок в VBA. У меня такая проблема. Я пытаюсь написать функцию, которая...

10
3209 / 959 / 222
Регистрация: 29.05.2010
Сообщений: 2,076
21.10.2012, 14:43 2
Если правильно понял (Столбец и удалить текст до конца - чего?), возможно так:
Visual Basic
1
2
3
4
5
6
7
8
Sub udal()
    Dim x As Range
    Dim np As Integer
    For Each x In Range("A1:B3")
        np = InStr(1, x, "ТОО")
        If np <> 0 Then x = Left(x, np + 2)
    Next
End Sub
1
1702 / 189 / 19
Регистрация: 20.11.2011
Сообщений: 281
21.10.2012, 14:49 3

Ctrl+H - найти "ТОО*", заменить на "ТОО"
И можно записать это макрорекордером.
1
1 / 1 / 0
Регистрация: 21.10.2012
Сообщений: 58
21.10.2012, 15:02  [ТС] 4
Ну вот к примеру имеются поставщики:
А1 - Сельхоз ТОО 1
А2 - Минвода ТОО г. Москва
в каждой ячейке нужно удалить весь текст после ТОО оставив только название ТОО. Т.е. в первом случае остается: Сельхоз ТОО (после ТОО пробела не должно быть).
0
5464 / 1144 / 50
Регистрация: 15.09.2012
Сообщений: 3,463
21.10.2012, 17:02 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
Sub Макрос2()
    
    'Здесь нужно указать, что ищем.
    Const sWhatFind As String = "ТОО"
    
    Dim rFind As Excel.Range, sAddress As String
    Dim lTextLenght As Long
    
    'Find быстрее работает, чем просмотр всех ячеек в заданном диапазоне.
    
    'Обратите внимание на:
        '1. LookAt:=xlPart, которое означает, что ищем фрагмент в ячейке.
        '2. MatchCase:=True - поиск с учётом регистра букв
            '(у нас заглавные буквы в искомом тексте).
    Set rFind = Range("A1:A2").Find(What:=sWhatFind, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)
        
    'Если есть результат, то запоминаем ячейку, где было найдено,
    'чтобы потом остановить цикл поиска.
    If Not rFind Is Nothing Then
        
        sAddress = rFind.Address
        
        'С помощью цикл Do ... Loop ищем остальные ячейки.
        Do
            
            'С помощью InStr находится искомый текст и определяется
            'порядковый номер искомого текста. Т.к. в искомом тексте
            '3 символа, то нужно добавить ещё число 3 (получено опытном путём).
            lTextLenght = InStr(rFind.Text, sWhatFind) + 3
            
            'Удаление из ячейки лишних данных.
            rFind.Characters(lTextLenght).Delete
            
            'Продолжаем поиск.
            Set rFind = Range("A1:A2").FindNext(rFind)
            
        Loop While rFind.Address <> sAddress
        
    End If
    
    'Сообщение о том, что код завершил работу.
    MsgBox "Работа кода завершена!", vbInformation
    
End Sub
1
72 / 0 / 0
Регистрация: 19.06.2014
Сообщений: 68
28.09.2015, 10:06 6
Скрипт, добрый день, а как проработать данную процедуру, если надо убрать текст от определенного слова, как здесь, до другого слова, например от слова паспорт до слова пример?
0
3490 / 2139 / 715
Регистрация: 02.11.2012
Сообщений: 5,613
28.09.2015, 13:38 7
Sweatcs, код от Скрипт в вашем случае не подойдет, а вот из второго сообщения подкорректировать можно.
0
72 / 0 / 0
Регистрация: 19.06.2014
Сообщений: 68
28.09.2015, 13:49 8
Vlad999, не могли бы Вы помочь с данным вопросом, никак не могу понять как это реализовать.
0
3490 / 2139 / 715
Регистрация: 02.11.2012
Сообщений: 5,613
28.09.2015, 14:04 9
Visual Basic
1
2
3
4
5
6
7
8
9
Sub udal()
    Dim x As Range
    Dim np As Integer, np1 As Integer
    For Each x In Range("A1:A3")
        np = InStr(1, x, "паспорт")
        np1 = InStr(1, x, "пример")
        If np <> 0 and  np1<>0 Then x = Left(x, np + 7) & " " & Mid(x,np1,256)
    Next
End Sub
проверяйте,
0
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
28.09.2015, 16:55 10
Аскар попробуйте протестировать макрос

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub replica()
   Dim t1$, l1&, i&, j&, i1&
   i1 = Range("A" & Cells.Rows.Count).End(xlUp).Row
   With CreateObject("VBScript.RegExp"): .Global = True: .IgnoreCase = True
       .Pattern = "[А-ЯЁ0-9]+"
   For j = 1 To i1
        t1 = Range("A" & j).Value: l1 = Len(t1)
      For i = 0 To .Execute(t1).Count - 1
        Set objMatch = .Execute(t1)(i)
          If objMatch.Value = "ТОО" Then
              With Range("A" & j).Characters(Start:= _
              objMatch.FirstIndex + 4, Length:=l1 - objMatch.FirstIndex - 3)
                .Delete
             End With
          End If
     Next i, j
  End With
End Sub
Вложения
Тип файла: xls example_29_09_2015_аскар.xls (37.5 Кб, 8 просмотров)
0
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
28.09.2015, 17:55 11
Аскар,или с учетом замены, в другом примере, слова ТОО на любое другое слово в тексте макроса.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub replica1()
  Dim t1$, l1&, i&, j&, i1&
   i1 = Range("A" & Cells.Rows.Count).End(xlUp).Row
   With CreateObject("VBScript.RegExp"): .Global = True: .IgnoreCase = True
       .Pattern = "[А-ЯЁ0-9]+"
   For j = 1 To i1
        t1 = Range("A" & j).Value: l1 = Len(t1)
      For i = 0 To .Execute(t1).Count - 1
        Set objMatch = .Execute(t1)(i)
          If objMatch.Value = "ТОО" Then
              With Range("A" & j).Characters(Start:= _
              objMatch.FirstIndex + objMatch.Length + 1, Length:=l1 - objMatch.FirstIndex - objMatch.Length)
                .Delete
             End With
          End If
     Next i, j
  End With
End Sub
Вложения
Тип файла: xls example_29_09_2015_аскар_2.xls (50.0 Кб, 11 просмотров)
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
28.09.2015, 17:55

Выведение текста после определенного слова
Доброго времени суток возник вопрос как вывести из списка всё что находится после слова 'ответ' ?...

Поиск определенного слова в строке и замена определенного символа после этого слова
Представим что у нас есть следующая строка: &quot;Дядя Петя 10 раз ударил дядю Васю, но дядя Вася...

Удаление текста после определённого слова
Всем привет! У меня возник вопрос. Как удалить текст после определённого слова, к примеру есть...

Удаление текста до определенного знака
Ребят, подскажите пожалуйста: есть много текста в ячейках, в каждом тексте есть разные фразы и...


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

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

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