Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

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

Автор Максим Саликов, 24.12.2015, 08:27

« назад - далее »

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

Что необходимо:
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

#1
вы бы в примере в столбце В показали что в итогу должно получится.
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)
Я, как всегда, чертовски адекватен... Email: pilipnikop@yandex.ua WM Z206653985942, R334086032478, U238399322728, E332314026771