Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
RegExp. Из вытащенной Pattern’ом подстроки нужно вытащить только все цифры.
 
#1
06.03.2018 10:52:29

Доброе утро.

Имеется столбец текстовых данных, половина которых заполнена вручную разными людьми.
Внутри текста есть 16-значный номер карты.

Учитывая человеческий фактор, он написан по-разному, в основном так:
6500 1234 5678 9999
6500-0101-0202-0303
6500660167026803
№6500123456789999

Реже встречаются такие, когда пишут каждые 4 цифры через пробел или тире, но где-то не ставят:
6500 11112222 3333
65009797 3545 5161
6500-0101-02020303

Сейчас я вытаскиваю номер карты таким макросом:
Код
Sub karta()
Dim x As Range, y As Range
Set y = Intersect(Selection, ActiveSheet.UsedRange)
d = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Column - y.Column + 1
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = "\D6500(\D?\d{4}){3}"
For Each x In y
s = x.Value
Set objMatches = objRegExp.Execute(s)
For i = 0 To objMatches.Count - 1
Set objMatch = objMatches.Item(i)
x.Offset(, d).Value = objMatch.Value & "_"
Next
Next
'y.Offset(, d).Replace "у", ""
'y.Offset(, d).Replace " ", ""
'y.Offset(, d).Replace "-", ""
'y.Offset(, d).Replace "№", ""
End Sub

Можно ли Pattern изменить так, чтобы из кода убрать ручные обработки y.Offset(, d).Replace…
То есть я вроде подобрал нужный Pattern, но теперь из вытащенной этим Pattern’ом подстроки нужно вытащить только цифры.
???
Изменено: Бахтиёр - 06.03.2018 10:59:39 (сорри, прикрепил новый файл)
 
 
 
#2
06.03.2018 11:36:31
Незнаю как регулярками, но Вашу проблему можно решить так
Код
For Each x In y
    Set objMatches = objRegExp.Execute(x.Value)
    x.Offset(, 1).Value = Replace(Replace(Replace(Replace(objMatches(0), "у", ""), "-", ""), "№", ""), " ", "") & "_"
Next
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
06.03.2018 12:12:23
Добрый день.
Можно еще таким паттерном попробовать:
Скрытый текст

Шерстим выделение и в каждой его ячейке заменяем введенный номер карты (даже среди прочего текста) на строку вида: "#### #### #### ####"
Изменено: Пытливый - 06.03.2018 12:17:50
Кому решение нужно - тот пример и рисует.
 
 
 
#4
06.03.2018 12:21:01
Код
Sub KardDgt(s$)
  Dim re, m, i&
  Set re = CreateObject("VBScript.RegExp"):  re.Pattern = "6500[\d -]{12,15}": re.Global = True
  Set m = re.Execute(s)
  For i = 0 To m.Count - 1
    Debug.Print Replace(Replace(m(i), " ", ""), "-", "")
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#5
06.03.2018 12:23:05
или для произвольных номеров карт с возможными пробелами или тире внутри:
Код
re.Pattern = "[\d -]{16,19}"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#6
06.03.2018 12:29:58
Доброе время суток.
Вариант функцией. Просто вывод последовательности из 12 цифр, положение которых удовлетворяет шаблону.
Код
Public Function getCartNumber(ByVal fromText As String) As String
    Static pReg As Object
    Dim sNum As String, pItem As Object
    If pReg Is Nothing Then
        Set pReg = CreateObject("VBScript.RegExp")
        pReg.Pattern = "\D(6500)\D?(\d{4})\D?(\d{4})\D?(\d{4})(?:\D|$)"
    End If
    For Each pItem In pReg.Execute(fromText)
        sNum = pItem.SubMatches(0) & pItem.SubMatches(1) & pItem.SubMatches(2) & pItem.SubMatches(3)
    Next
    getCartNumber = sNum
End Function

Успехов.
 
 
 
#7
06.03.2018 12:31:59
Спасибо всем, изучаю решения.
 
 
 
#8
06.03.2018 12:42:03
Если номер карты только один в ячейке , то можно попробовать так
Код
Function iKarta(cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "6500 ?-?\d{4} ?-?\d{4} ?-?\d{4}\b"
     iKarta = .Execute(cell)(0)
 End With
End Function
 
 
 
#9
06.03.2018 12:46:59
Коллеги, а про эту часть забываем? Не только же вытащить то, что удовлетворяет шаблону, но и трансформировать
Цитата
Бахтиёр написал:
из вытащенной этим Pattern’ом подстроки нужно вытащить только цифры.
 
 
 
#10
06.03.2018 12:52:04
Какой будет результат выполнения программы:
D=-0.121
KS=1
FOR J=1 TO 7 STEP 3
KS=KS+J^2
NEXT J
MsBox KS
 
 
 
#11
06.03.2018 12:53:48
Ігор Гончаренко, Пытливый, Sanja, Kuzmich, спасибо вам всем.

Андрей VG,  спасибо, это именно то, что я хотел (без Replace, средствами RegExp вытащить нужный конечный результат) реализовать, но не хватило знаний.

Переделал вашу функцию в макрос:
Код
Sub getCartNumber()
    Static pReg As Object
    Dim sNum As String
    If pReg Is Nothing Then
        Set pReg = CreateObject("VBScript.RegExp")
        pReg.Pattern = "\D(6500)\D?(\d{4})\D?(\d{4})\D?(\d{4})(?:\D|$)"
    End If
    For Each x In Selection
        For Each k In pReg.Execute(x.Value)
            sNum = k.SubMatches(0) & k.SubMatches(1) & k.SubMatches(2) & k.SubMatches(3)
        Next
        x.Offset(, 1).Value = sNum & "_"
    Next
End Sub
Изменено: Бахтиёр - 06.03.2018 13:05:08
 
 
 
#12
06.03.2018 13:01:21
JinxKill, это о чем? К теме какое отношение имеет?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#13
06.03.2018 13:06:34
Sanja, к этой теме наверное никакого, просто помощь по этому задаю нужна, думала посогут
 
 
 
#14
06.03.2018 13:24:38
а так, покатит:)
Код
        pReg.Pattern = "6500\D?(\d{4})\D?(\d{4})\D?(\d{4})"
    End If
    For Each x In Selection
        For Each k In pReg.Execute(x.Value)
            sNum = "6500" & k.SubMatches(0) & k.SubMatches(1) & k.SubMatches(2)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#15
06.03.2018 13:39:01
Бахтиёр, тогда лучше написать так (фрагмент)
Код
    For Each x In Selection
        sNum = ""
        For Each k In pReg.Execute(x.Value)

Иначе, если в строке нет подстроки по шаблону, вы получите предыдущее состояние sNum, что не верно - нужно вывести пусто, как признак отсутствия номера карты.
 
 
 
#16
06.03.2018 13:46:15
еще вариант функции
Код
Function myCarta$(text$)
  text = Replace(Replace(text, "-", ""), " ", "")
With CreateObject("VBScript.RegExp"): .IgnoreCase = True: .Pattern = "на(?:карту№?)?(6500\d+)"
  myCarta = .Execute(text)(0).Submatches(0)
End With
End Function
Изменено: кузя1972 - 06.03.2018 13:46:36
 
 
 
#17
06.03.2018 14:53:22
Цитата
Андрей VG:  лучше написать так
понятно
 
 
 
#18
06.03.2018 15:10:39
С крутыми банками Вы работаете... ;)  
Владимир
 
 
 
Страницы: 1
Наверх