Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 22 След.
Поставить двоеточие после некоторых цифр
 
вариант функции в G1
Код
 Function uuu$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "(\d{10})(\d{2})(\d{3})(\d{4})": .Global = True
    uuu = .Replace(t, "$1:$2:$3:$4")
  End With
End Function
Изменено: sv2013 - 18.05.2018 10:17:09
Извлечь из текста фрагмент: 3 цифры, дефис, 7 цифр
 
ещё вариант функции
Код
Function uuu$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "\d{3}\-\d{7}": uuu = .Execute(t)(0)
  End With
End Function
Изменено: sv2013 - 21.10.2017 01:16:00
Как вытащить из строки текст, который обрамлен <>
 
для примера #7:

Код
 Sub test2()
   Dim t$, i&: t = Range("B4")
  With CreateObject("VBScript.RegExp"): .Pattern = "<(.+?)>": .Global = True
     For i = 0 To .Execute(t).Count - 1: Range("B8").Offset(i).Value = .Execute(t)(i).Submatches(0): Next
  End With
End Sub
Изменено: sv2013 - 18.10.2017 18:20:13
Как вытащить из строки текст, который обрамлен <>
 
ещё вариант макроса,кнопки test и очистка
 
Код
Sub test()
  Dim t$, i&: t = Range("A1")
  With CreateObject("VBScript.RegExp"): .Pattern = "<(.+?)>": .Global = True
     For i = 0 To .Execute(t).Count - 1: Range("B1").Offset(, i).Value = .Execute(t)(i).Submatches(0): Next
  End With
End Sub
Изменено: sv2013 - 18.10.2017 18:09:04
Отделение буквенно-цифрового артикула от Наименования
 
вариант макроса,соответствующего функции vvv,кнопки test и повтор,лист Лист3 вспомогательный для демонстрации повтора.
Код
Sub test1()
     Dim z, t$, t1$, i&: z = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .IgnoreCase = True
    For i = 1 To UBound(z): t = z(i, 1): t1 = uuu(t): .Pattern = "^.+(?=" & t1 & ")"
      z(i, 1) = .Replace(t, "")
    Next
   Range("B1").Resize(UBound(z), 1).Value = z
   End With
End Sub
Код
Function uuu(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "[а-яё]{3,}": .IgnoreCase = True
  uuu = .Execute(t)(0)
  End With
End Function
Изменено: sv2013 - 16.10.2017 10:08:49
Отделение буквенно-цифрового артикула от Наименования
 
ещё вариант функции в столбце C
 
Код
Function uuu(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "[а-яё]{3,}": .IgnoreCase = True
  uuu = .Execute(t)(0)
  End With
End Function
Код
Function vvv(t$)
  With CreateObject("VBScript.RegExp")
  .Pattern = "^.+(?=" & uuu(t) & ")": vvv = .Execute(t)(0)
 End With
End Function
Изменено: sv2013 - 13.10.2017 23:18:49
Атрибуты Тега <a>. Получить текст между символами ><
 
как вариант данные в A1 результат в O1
Код
Function vvv(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = ">(\d+)<"
  vvv = .Execute(t)(0).Submatches(0)
  End With
End Function
Изменено: sv2013 - 12.10.2017 00:40:01
Удаление повторов значений в ячейке
 
еще вариант
Код
Function zzz(t$)
 With CreateObject("Scripting.Dictionary"): .CompareMode = 1
    For Each t1 In Split(t, "-"): .Item(Trim(t1)) = 0: Next
    zzz = Left(Join(.Keys, "-"), Len(Join(.Keys, "-")) - 1)
 End With
End Function
Изменено: sv2013 - 11.10.2017 18:06:11
Макрос замены текста по регулярному выражению.
 
нужен файл-пример,как вариант в I1
Код
Function uuu$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "[^:]+": .Global = True
  uuu = "|" & Trim(.Execute(t)(.Execute(t).Count - 1))
  End With
End Function
Изменено: sv2013 - 10.10.2017 16:41:33
Извлечение цифр по условию
 
вариант функции в C2
 
Код
Function vvv(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "на общую сумму (\d+) рублей"
     If .test(t) Then vvv = .Execute(t)(0).Submatches(0) Else vvv = t
  End With
End Function
Изменено: sv2013 - 05.10.2017 23:03:07
Вытащить текст между двумя символами
 
еще вариант функции в столбце C
Код
 Function vvv$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "[^\\]+": .Global = True
    vvv = .Execute(t)(1)
  End With
End Function
Изменено: sv2013 - 26.09.2017 01:49:32
Цифры из текста по условию и в сумму!
 
еще вариант в виде функции в D5 :без Submatches,со считыванием в массив

 
Код
Function vvv#(r As Range)
       Dim z: z = r.Value
With CreateObject("VBScript.RegExp"): .Pattern = "\d+\.\d+"
  For i = 1 To UBound(z): t = z(i, 1)
     If .test(t) Then vvv = vvv + Replace(.Execute(t)(0), ".", ",")
  Next
End With
End Function
Изменено: sv2013 - 04.09.2017 18:29:20
Разбиение ряда цифр символом "*"
 
еще вариант функции
Код
Function vvv$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = ".": .Global = True
  vvv = .Replace(t, "*$&") & "*"
  End With
End Function
Изменено: sv2013 - 31.08.2017 17:14:58
Найти тире в определенных случаях, и убрать.
 
вариант макроса,соответствующего #6 и выложенному файл-примеру,кнопки test и повтор
Код
 Sub test()
     Dim z, t$, i&: z = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = 1 To UBound(z): t = z(i, 1)
      z(i, 1) = StrReverse(Split(StrReverse(t), "-", 2)(1)) & Chr(32) & StrReverse(Split(StrReverse(t), "-", 2)(0))
    Next
   Range("A3").Resize(UBound(z), 1).Value = z
End Sub
Изменено: sv2013 - 30.08.2017 23:06:03
Найти тире в определенных случаях, и убрать.
 
вариант функции в столбце B
Код
 Function zzz$(t$)
  zzz = StrReverse(Split(StrReverse(t), "-", 2)(1)) & Chr(32) & StrReverse(Split(StrReverse(t), "-", 2)(0))
End Function
Изменено: sv2013 - 30.08.2017 21:58:13
Разделить столбец на текст, процент и числа
 
еще вариант функций в столбцах F H J соответственно
Код
Function vvv$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "^.+(?= \d+\%)"
      vvv = .Execute(t)(0)
  End With
End Function
Код
Function uuu$(t$)
  With CreateObject("VBScript.RegExp"): .Pattern = "\d+\%\d+\%\d+\%"
      uuu = .Execute(t)(0)
  End With
End Function
Код
Function yyy$(t$)
  yyy = Replace(Replace(t, vvv(t), ""), uuu(t), "")
End Function
Изменено: sv2013 - 26.08.2017 23:57:16
Убрать лишний текст из телефонных номеров
 
еще вариант функции
 
Код
Function uuu$(t$)
 Dim t1$
 With CreateObject("VBScript.RegExp"): .Pattern = "(\+7|[-\d\s\)\(]+"
  If .test(t) Then t1 = .Execute(t)(0) Else t1 = ""
  .Pattern = "[-\(\)\s]": .Global = True
  t1 = .Replace(t1, ""): .Pattern = "(\+7|8)\d{10}"
 If .test(t1) Then uuu = .Execute(t1)(0) Else uuu = ""
 End With
End Function
Изменено: sv2013 - 23.08.2017 18:47:59
Убрать часть текста с кириллицей
 
вариант функции в I2 и макрос с выводом результата в столбце A, кнопки test и повтор.
Код
 Function vvv$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "^.+(?=\./)"
  vvv = .Execute(t)(0)
 End With
End Function
Код
Sub test()
     Dim z, t$, i&: z = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .Pattern = "^.+(?=\./)"
    For i = 1 To UBound(z): t = z(i, 1):   z(i, 1) = .Execute(t)(0): Next
      Range("A2").Resize(UBound(z), 1).Value = z
   End With
End Sub
Изменено: sv2013 - 20.08.2017 21:12:45
Удалить текст из ячейки кроме слова в кавычках
 
ещё вариат паттерна  (Pattern) и берем .Execute(t)(1)
"[^""]+"
Код
Function vvv(t)
 With CreateObject("VBScript.RegExp"): .Pattern = "[^""]+": .Global = True
  vvv = .Execute(t)(1)
 End With
End Function
Изменено: sv2013 - 16.08.2017 22:16:35
Как в столбце убрать цифры в конце строк. А в самих строках не трогать.
 
вариант функции в столбце B
Код
 Function vvv(t$)
  Dim t1$
  With CreateObject("VBScript.RegExp"): .Pattern = " \d+ $"
  t1 = .Execute(t)(.Execute(t).Count - 1)
  .Pattern = "^.+(?=" & t1 & ")"
     If .test(t) Then vvv = .Execute(t)(0) Else vvv = t
  End With
End Function
Изменено: sv2013 - 30.07.2017 12:44:59
Как добавить знак плюса после каждого 1 или 2 символьного слова или цифры?
 
вариант функции yyy  в C1 или uuu
Код
Function uuu$(t$)
   Dim i%, t1$
   With CreateObject("VBScript.RegExp"): .Global = True: .IgnoreCase = True
    .Pattern = "(?:[^-а-яё\d]|^)[-а-яё\d]{1,2}(?=[^-а-яё\d]|$)"
           t1 = .Replace(t, "$&+"): uuu = Replace(t1, "+ ", "+")
  End With
End Function


Код
Function yyy$(t$)
   Dim i%
   With CreateObject("VBScript.RegExp"): .Global = True: .IgnoreCase = True
    .Pattern = "(?:[^-а-яё\.,\d]|^)[-а-яё\.,\d]{1,2}(?=[^-а-яё\.,\d]|$)"
           yyy = .Replace(t, "$&+")
  End With
End Function
Изменено: sv2013 - 26.07.2017 05:35:47
убрать лишние символы в одной ячейке
 
еще вариант функции в столбце B
Код
Function vvv(t)
 With CreateObject("VBScript.RegExp"): .Pattern = "\D": .Global = True
  vvv = .Replace(t, "")
 End With
End Function
Изменено: sv2013 - 25.07.2017 21:34:34
Преобразовать текст в дату
 
в #10 опечатка,надо:
Код
 a(i, 1) = Replace(a(i, 1), "г", "")
Изменено: sv2013 - 15.07.2017 08:57:38
Преобразовать текст в дату
 
еще вариант функции и соответствующий ей макрос,кнопки test и повтор
 
Код
Function vvv(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "г"
    vvv = CDate(.Replace(t, ""))
 End With
End Function
Код
Sub test()
     Dim z, t$, i&: z = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .Pattern = "г"
    For i = 1 To UBound(z): t = z(i, 1)
      z(i, 1) = CDate(.Replace(t, ""))
    Next
   Range("E1").Resize(UBound(z), 1).Value = z
   End With
End Sub
Изменено: sv2013 - 14.07.2017 23:28:26
Как разделить ячейку на две?, Кратко: есть ячейка, в ней - текст, и дата в конце. Нужно поместить текст в одну ячейку, а дату в другую.
 
вариант функции
Код
Function vvv1$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "\D+": .Global = True
    vvv1 = .Execute(t)(0)
 End With
End Function
Код
Function vvv2$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "\d+.\d+.\d+"
    vvv2 = .Execute(t)(0)
 End With
End Function
Изменено: sv2013 - 06.07.2017 21:06:27
Из столбца в столбец скопировать слова соответствующие шаблону
 
вариант функции в столбце D
Код
 Function vvv$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "\w+\.ru"
    vvv = .Execute(t)(0)
 End With
End Function
Изменено: sv2013 - 22.06.2017 16:14:25
удалить e-mail c ячейки, Подскажите как удалить с ячейками с несколькими мейлами ненужый мейл (в принципе любой) и оставить только один e-mail
 
вариант макроса с результатом в столбце A,кнопки test и повтор,функция vvv в столбце F
Код
Sub test()
     Dim z, t$, i&: z = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
  With CreateObject("VBScript.RegExp"): .Pattern = "[^,]+"
    For i = 1 To UBound(z): t = z(i, 1)
      z(i, 1) = .Execute(t)(0)
    Next
   Range("A1").Resize(UBound(z), 1).Value = z
   End With
End Sub
Изменено: sv2013 - 19.05.2017 18:48:09
Как удалить пробел в конце ячеек?
 
вариант функции в столбце B
Код
 Function uuu$(t$)
 With CreateObject("VBScript.RegExp"): .Pattern = "\s$"
    uuu = .Replace(t, "")
 End With
End Function
Изменено: sv2013 - 01.05.2017 19:57:46
Извлечь из ячейки второе слово
 
вариант функции в столбце B
Код
 Function vvv$(t$)
   With CreateObject("VBScript.RegExp"): .Global = True: .IgnoreCase = True
    .Pattern = "(?:[^а-яё\w]|^)[а-яё\w]+(?=[^а-яё\w]|$)"
      vvv = Trim(.Execute(t)(1))
  End With
End Function
Изменено: sv2013 - 01.05.2017 15:03:41
Перенести часть текста из середины в начало
 
еще вариант функции в столбце B
Код
 Function vvv$(t$)
   Dim t1$
 With CreateObject("VBScript.RegExp"): .Pattern = "[а-яё]+ [а-яё]+": .IgnoreCase = True
    t1 = .Execute(t)(0): .Pattern = "\d+%": vvv = .Execute(t)(0) & " - " & t1
 End With
End Function
Изменено: sv2013 - 26.04.2017 19:00:46
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 22 След.
Наверх