Макрос обработки текстовых ячеек

[Максим Саликов]

Что необходимо:
1. Макрос читает выделенные ячейки
2. если в ячейке есть символ "-", удалить его и все что после него.

Пример:
было: текст текст -текст после четрочки
стало: текст текст

(Решено):

Код Выделить Развернуть

Sub УдалениеПосЧерт()
Selection.Replace What:="-*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub


3. Если текст в ячейке не начинается с кавычки, то поставить перед каждым словом "+".

Пример:
было: текст текст
стало: +текст +текст

(Решено):

Код Выделить Развернуть

Sub ПостПлюс()
Selection.Replace What:=" ", Replacement:=" +"
For Each c In Selection
c.Value = "+" & c.Value
Next c
End Sub


3. Если текст в ячейке напечатан в "кавычках", то заменить кавычки на квадратные скобки и привести к виду [текст]

Пример:
было: "текст текст"
стало: [текст текст]

Ни как не могу составить алгоритм в VBA

Ну и собственно самая главная задача заключается в том, чтобы все эти действия делал 1 макрос. Пример таблицы, которую он должен обрабатывать прилагается во вложении.

Очень прошу, помогите, голова кипит уже.

Добавлено:

Скинули формулу, выполняющую эти функции, которая тоже нуждается в доработке

Код Выделить Развернуть

=ЕСЛИ(ЕОШИБКА(ПОИСК("""";A1));"+"&ПОДСТАВИТЬ(ПОДСТАВИТЬ(ЕСЛИОШИБКА(ЛЕВБ(A1;ПОИСК("-";A1)-1);A1);"""";"[";1);"""";"]");ПОДСТАВИТЬ(ПОДСТАВИТЬ(ЕСЛИОШИБКА(ЛЕВБ(A1;ПОИСК("-";A1)-1);A1);"""";"[";1);"""";"]"))

она ставит плюс только перед первым словом, а надо перед каждым, кто знает как сделать помогите пожалуйста.

[cheshiki1]

вы бы в примере в столбце В показали что в итогу должно получится.

Код Выделить Развернуть

Sub ÓäàëåíèåÏîñ×åðò()
Dim c
Application.ScreenUpdating = False

With Selection
.Replace What:=" -*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:=" ", Replacement:=" +"
.Replace What:="""", Replacement:="["
End With

For Each c In Selection
c.Value = "+" & c.Value
Next c

Application.ScreenUpdating = True
End Sub

УПС про квадратные скобки упустил, нужно код дополнять.
Чтоб не печатало кракозябры, попробуйте заменить C_1252.NLS на C_1251.NLS переименовав его в C_1252.NLS. Оба они находятся в c:\Windows\System32\
Возможно придется воспользоваться Unlocker.

[kuklp]

Для скобок-кавычек. Остальное скомбинируете самостоятельно.

Код Выделить Развернуть

Public Sub www()
    Dim oM As Object, c As Range, v, s$
    With CreateObject("VBScript.RegExp")
        .Pattern = "\" & Chr(34) & "([^\" & Chr(34) & "]+)\" & Chr(34) & ""
        .Global = True
        For Each c In UsedRange.Columns(1).Cells
            s = c.Value
            Set oM = .Execute(s)
            For Each v In oM
                s = Replace(s, v.Value, "[" & Replace(v.Value, Chr(34), "") & "]")
            Next
            c(1, 2).Value = Application.Trim(s)
        Next
    End With
End Sub
Чтоб меняло на месте, вместо строки c(1, 2).Value = Application.Trim(s) надо c.Value = Application.Trim(s)