Страницы: 1
RSS
копирование значения ячейки в другую по критерию, копирование значения ячейки в другую по критерию
 
просьба подсказать способ, как выделить в отдельный столбец адреса электронной почты. например, по критерию только текст с символом "@"  
 
Код
=ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);100)
 
спасибо, но в первой строке потерялся один из емейлов. их изначально два
 
Если есть объединить() - все мейлы одним массивом вывести:
=ФИЛЬТР.XML("<l><i>"&ПОДСТАВИТЬ(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ОБЪЕДИНИТЬ(" ";1;B2:B3);"<";">");">";" "));" ";"</i><i>")&"</i></l>";"//i[contains(.,'@')]")
 
Ну два так два  :D
Код
=СЖПРОБЕЛЫ(ЛЕВСИМВ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);200);НАЙТИ(" ";ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);200))))&" "&СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);200));" ");",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100));МАКС(НАЙТИ("@";ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);200));" ");",";" ");">";" ");"<";" ");" ";ПОВТОР(" ";100)))-100;1);200))
 
спасибо, но разделить два и более адреса нужно по отдельным столбцам
 
Цитата
два и более адреса
=ТРАНСП(ФИЛЬТР.XML("<l><i>"&ПОДСТАВИТЬ(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(B2;"<";">");">";" "));" ";"</i><i>")&"</i></l>";"//i[contains(.,'@')]"))
Изменено: Павел \Ʌ/ - 08.10.2024 15:19:44
 
Выделите ячейки, запустите макрос SplitEmail.
Код
Option Explicit

Sub SplitEmail()
    Dim cl As Range
    For Each cl In Intersect(Selection, ActiveSheet.UsedRange).Cells
        SplitCell cl.Value, cl.Cells(1, 2)
    Next
End Sub

Private Sub SplitCell(sText As String, reportCell As Range)
    Dim arr As Variant
    arr = Split(sText, "@")
    If UBound(arr) <= LBound(arr) Then Exit Sub
    Dim brr As Variant
    ReDim brr(LBound(arr) To UBound(arr) - 1)
    
    Dim ya As Long
    For ya = LBound(arr) To UBound(arr) - 1
        brr(ya) = GetRev(arr(ya))
        brr(ya) = brr(ya) & "@" & GetPre(arr(ya + 1))
    Next
    
    reportCell.Resize(, UBound(brr) - LBound(brr) + 1).Value = brr
End Sub

Private Function GetPre(ByVal ss As String) As String
    Dim res As String
    Dim ch As String
    Dim ii As Long
    For ii = 1 To Len(ss) Step 1
        ch = Mid(ss, ii, 1)
        If Not IsValidSymbol(ch) Then
            Exit For
        End If
        res = res & ch
    Next
    GetPre = res
End Function

Private Function GetRev(ByVal ss As String) As String
    Dim res As String
    Dim ch As String
    Dim ii As Long
    For ii = Len(ss) To 1 Step -1
        ch = Mid(ss, ii, 1)
        If Not IsValidSymbol(ch) Then
            Exit For
        End If
        res = ch & res
    Next
    GetRev = res
End Function

Private Function IsValidSymbol(ch As String) As Boolean
    IsValidSymbol = ch Like "[A-Za-z0-9._-]"
End Function
 
всем участвовавшим спасибо, вопрос закрыт
Изменено: ghf - 08.10.2024 16:02:29
Страницы: 1
Наверх