Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос обработки текстовых ячеек
 
#1
24.12.2015 07:10: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 макрос. Пример таблицы, которую он должен обрабатывать прилагается во вложении.

Очень прошу, помогите, голова кипит уже.
 
 
 
#2
24.12.2015 07:44:39
Нашел макрос замены кавычек на квадратные скобки, но он работет только в Word. Подскажите, можно ли как нибудь переделать его под Excel
Код
Sub changeQuote()
'Замена прямых кавычек на парные кавычки (елочки)
Dim blnQuotes As Boolean
'запомнить пользовательскую установку
blnQuotes = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = False
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = """(*)"""
.Replacement.Text = "[\1]"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
'восстановить пользовательскую установку
Options.AutoFormatAsYouTypeReplaceQuotes = blnQuotes
End Sub
Изменено: manimeiker - 24.12.2015 07:47:06 (пробелы и ошибка)
 
 
 
#3
24.12.2015 07:53:18
Что мешает для квадратных скобок использовать тот же самый Replace, что и во всех предыдущих блоках кода?
 
 
 
#4
24.12.2015 08:18:45
в начале текста необходимо поставить "[" а в конце "]"

а как это реализовать, у меня мозгов не хватает к сожалению... а может и к счастью )))
 
 
 
#5
24.12.2015 08:26:52
Код
Sub Спи_спокойно_дорогой_друг()
Columns(2).Clear
For Each t In Selection
t.Offset(, 1).Value = Split(t.Value, "-")(0)
  If Asc(Left(t.Offset(, 1).Value, 1)) = 34 Then
    t.Offset(, 1).Value = "[" & Replace(Replace(t, " ", " +", 1), """", "") & "]"
  End If
Next t
End Sub
 
 
 
#6
24.12.2015 08:27:54
Вот здесь Вы добавляете плюс в начало
Код
c.Value = "+" & c.Value
делайте аналогично. Ну, и как в конец добавить думаю сообразите.
 
 
 
#7
24.12.2015 08:45:52
k61, к сожалению мне все еще не спится(ться)... ((
макрос работает. реально работает, только сделайте так чтобы он плюсики ставил перед каждым словом (и первым тоже) которые НЕ в кавычках, а фразы которые в кавычках остались без изменений, тоесть без плюсов!

Спасибо огромное! Подарили надежду честно говоря!
 
 
 
#8
24.12.2015 08:52:50
Цитата
manimeiker написал:
а фразы которые в кавычках остались без изменений, тоесть без плюсов!
но квадратные скобки добавляем?
 
 
 
#9
24.12.2015 08:58:21
Да конечно, просто надо чтобы плюсики были перед теми словами которые НЕ в скобках
 
 
 
#10
24.12.2015 09:03:56
монстр:
Код
Sub Спи_спокойно_дорогой_друг_1()
Columns(2).Clear
For Each t In Selection
t.Offset(, 1).Value = Replace(Replace(Split(t.Value, "-")(0), " ", " +"), " ++", " +")
  If Asc(Left(t.Offset(, 1).Value, 1)) = 34 Then:    t.Offset(, 1).Value = "[" & Replace(Replace(t, " ", " +", 1), """", "") & "]"
Next t
End Sub
 
 
 
#11
24.12.2015 09:32:49
все равно не работает ((, протестируйте пожалуйста с приложенным в первом сообщении файлом.
 
 
 
#12
24.12.2015 10:46:15
Код
Sub Спи_спокойно_дорогой_друг_2()
Columns(2).Clear
For Each t In Selection
tt = Replace(Replace(Split(t.Value, "-")(0), " ", " +"), " ++", " +")
  If Asc(Left(tt, 1)) = 34 Then
  tt = "[" & Replace(Replace(tt, """", ""), " +", " ") & "]"
  Else
    If Asc(Right(tt, 1)) = 43 Then: tt = Left(tt, Len(tt) - 2)
    End If
  End If
t.Offset(, 1).Value = tt
Next t
End Sub
 
 
 
#13
24.12.2015 11:22:27
Доброе время суток
Вариант на регулярных выражениях.

С наступающими.
Изменено: Андрей VG - 24.12.2015 11:23:59
 
 
 
#14
24.12.2015 12:23:48
Кросс
 
 
 
#15
24.12.2015 19:01:19
Выспался, Все получилось. спасибо огромное за помощь!
 
 
 
Страницы: 1
Читают тему
Наверх