Удалить текст в ячейках между двумя словами

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Удалить текст в ячейках между двумя словами (Макросы/Sub)

Studentka86

Дата: Среда, 20.03.2019, 11:09 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Здравствуйте гуру!

Мне нужно удалить все, что между (слова, числа, символы) словом "программам" и "20" (или "19") в ячейках в одном столбце.
В одной ячейке может быть несколько раз такая конструкция. Всегда есть словосочетание "программам подготовки", всегда дальше через разное количество символом идет 20.. или 19..

Пыталась скомпановать код, но он очень сырой. Как добавить "20", почему у меня проверяется 57 ячеек вместо 10, при этом некоторые перепрыгивает (видимо зациклила неправильно) ...

Буду благодарна, если ответите с пояснениями.

[vba]

Код

Sub Udalit_mejdu_slovami()
For j = 1 To 10
Cells(ActiveCell.Row + j, ActiveCell.Column + 0).Select
Dim a(), i&, txt$
a = Array("подготовки", "19")
txt = ActiveCell.text
s = Split(txt, a(0))
For i = 1 To UBound(s)
sv = Split(s(i), a(1))
If UBound(sv) > 0 Then
sv(0) = ""
s(i) = Join(sv, a(1))
End If
Next
txt = Join(s, "")
ActiveCell.Value = txt
Next
End Sub

[/vba]
Я тут начала с ActiveCell, но не принципиально, можно просто прописать для Столбца В (или С).

К сообщению приложен файл: ____2_.xlsx (9.9 Kb)

Сообщение отредактировал Studentka86 - Среда, 20.03.2019, 11:21

Ответить

китин

Дата: Среда, 20.03.2019, 11:11 | Сообщение № 2

Группа: Модераторы

Ранг: Экселист

Сообщений: 7029

Репутация: 1078 ±

Замечаний: 0% ±

Excel 2007;2010;2016

- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852

Ответить

_Boroda_

Дата: Среда, 20.03.2019, 14:14 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

Репутация: 6505 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Такой вариант
[vba]

Код

Sub tt()
    t_ = "программам "
    c_ = 2
    r0_ = 2
    z_ = 2
    ReDim aris(1 To z_)
    aris(1) = " 19"
    aris(2) = " 20"
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    ar = Cells(r0_, c_).Resize(n_)
    For i = 1 To n_
        ars = Split(ar(i, 1), t_)
        For j = 1 To UBound(ars)
            x_ = 0
            x0_ = 0
            For k = 1 To z_
                x0_ = InStr(ars(j), aris(k))
                If x0_ Then
                    If x_ Then
                        If x_ > x0_ Then
                            x_ = x0_
                        End If
                    Else
                        x_ = x0_
                    End If
                End If
            Next k
            If x_ Then
                ars(j) = Mid(ars(j), x_ + 1)
            End If
        Next j
        For j = 0 To UBound(ars) - 1
            ars(j) = ars(j) & Trim(t_)
        Next j
        ar(i, 1) = Join(ars)
    Next i
    Cells(r0_, c_ + 1).Resize(n_) = ar
End Sub

[/vba]

К сообщению приложен файл: _2_1.xlsm (18.4 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Studentka86

Дата: Среда, 20.03.2019, 16:02 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 13

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

_Boroda_, вы гений!
Сейчас немножко спасибо отправлю на вебмани.

Ответить

Удалить текст в ячейках между двумя словами (Макросы/Sub)

Страница 1 из 1
1