Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Разделить столбец на текст, процент и числа
 
#1
26.08.2017 23:09:05
Здравствуйте. Подскажите пожалуйста, как можно реализовать. Нужно разделить в столбце отдельно текст, проценты и  числа...

Ниже в примере первые две строки показано  
 
 
 
#2
26.08.2017 23:37:45
Третья строчка пример, протянешь и всё вроде должно работать
 
 
 
#3
26.08.2017 23:39:37
Цитата
разделить в столбце отдельно текст, проценты и  числа...
UDF
Код
Function iText(cell$) As String
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = ".+(?= \d{1,2}%)"
     iText = .Execute(cell)(0)
 End With
End Function

Function iPercent(cell$) As String
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "\d{1,2}%\d{1,2}%\d{1,2}%"
     iPercent = .Execute(cell)(0)
 End With
End Function

Function iChislo(cell$) As String
  iChislo = Split(cell, "%")(3)
End Function
 
 
 
#4
26.08.2017 23:49:14
Kuzmich, отлично!! Спасибо огромное , все подходит)
 
 
 
#5
26.08.2017 23:49:28
bylanovandrej, спасибо большое!
 
 
 
#6
26.08.2017 23:56:49
еще вариант функций в столбцах 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
 
 
 
#7
27.08.2017 09:40:03
sv2013, очень благодарен! :)  
 
 
 
#8
27.08.2017 10:15:57
Код
=ПОДСТАВИТЬ(ПОДСТАВИТЬ(A1;D1;"");C1;"")
=ПРАВСИМВ(ПОДСТАВИТЬ(A1;D1;"");(ДЛСТР(ПОДСТАВИТЬ(A1;D1;""))-НАЙТИ("!";ПОДСТАВИТЬ(A1;"%";"!";1)))+3)
=ПРАВСИМВ(A1;ДЛСТР(A1)-НАЙТИ("!";ПОДСТАВИТЬ(A1;"%";"!";3)))
Изменено: z_sir - 27.08.2017 10:18:28
 
 
 
#9
27.08.2017 11:05:56
Еще вариант:
=СЖПРОБЕЛЫ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B1;D1;"");E1;""))
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B1;E1;"");" ";ПОВТОР(" ";100));100))
=СЖПРОБЕЛЫ(ПРАВБ(ПОДСТАВИТЬ(B1;"%";ПОВТОР(" ";100));100))
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
 
 
#10
27.08.2017 11:40:57
Или UDF массива  ;)
Код
Function qqq(s$)
    Dim t(2), objRegExp As Object, oMatches As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .Global = True: .IgnoreCase = False: .MultiLine = False
        .Pattern = "^.+?(?=\d+%)|\d+.+%"
        If .test(s) Then
            Set oMatches = .Execute(s)
            t(0) = oMatches(0)
            t(1) = oMatches(1)
            t(2) = .Replace(s, "")
        End If
    End With
    qqq = t
End Function
 
 
 
#11
27.08.2017 20:45:02
Всем огромное спасибо!
 
 
 
Страницы: 1
Наверх