在excel中找到特定單詞時在單元格中拆分字符串

Question

我正在處理包含 1000 個條目的 Excel 表。 我在一個單元格中有電話號碼和電子郵件，我想將它們分開。
我使用數據選項卡選項，但有些行有,分隔，有些行有空間分隔電話和電子郵件。

B列中的數據與

Tel.: 05164 / 801623 Mobil: 0171 / 2337496 mail: Irisahlden(at)web(dot)de

電子郵箱：irj@gmail.com，電話：3927-743627

電話：45937/28627 郵箱：hurjd@hotmail.com

有什么辦法可以將電子郵件和電話分開在不同的單元格中嗎？

Answer 1

您可以按照此操作將數字從單元格中分離出來，如果您希望將它們包含在內，則必須在分隔符中進行一些檢查。 請參閱： 如何從字符串中查找數字？

電子郵件地址，您最好搜索字符串中的“@”或“(at)”，然后獲取前后的所有字符，直到找到空格。 或者，為了使搜索更容易一些，將所有“(at)”和“(dot)”替換為“@”和“.”。 請參閱： 檢查一個字符串是否包含另一個字符串

希望這可以幫助。

Answer 2

我把它當作一個挑戰

嘗試這個

Option Explicit

Sub main()
Dim cell As Range
Dim iAt As Long, iDot As Long, iSpace As Long, iMail As Long, i As Long

'get wanted sheet column "B" cells with string values only
With Worksheets("MAIL_TEL").Columns("B").SpecialCells(xlCellTypeConstants, xlTextValues) '<== change "MAIL_TEL" with actual sheet name

    Application.DisplayAlerts = False
    .Replace what:=",", Replacement:=" ", lookAt:=xlPart, MatchCase:=False 'replace 'commas' (",") with 'spaces' (" ")
    .Replace what:="(dot)", Replacement:=".", lookAt:=xlPart, MatchCase:=False ' make sure having real 'dot's (".")
    .Replace what:="(at)", Replacement:="@", lookAt:=xlPart, MatchCase:=False ' make sure having real 'At's ("@")
    Application.DisplayAlerts = True

    'loop through cells to parse the position of "mail" info from other info ('telephone' info, as far as your data show)
    For Each cell In .Cells

        cell.Value = WorksheetFunction.Trim(cell.Value) 'remove multiple spaces

        iAt = InStr(cell.Value, "@") 'search for 'At' ("@") to check for 'mail' info
        If iAt > 0 Then
            iMail = InStr(UCase(cell.Value), "MAIL") 'search for "mail"
            iSpace = InStrRev(Left(cell.Value, iMail - 1), " ") 'search for the 'space' (" ") preceeding "mail"
            If iSpace > 0 Then '"mail" was not the first "info" -> place the "|" separator
                cell.Value = Mid(cell.Value, 1, iSpace) & "|" & Mid(cell.Value, iSpace + 1, Len(cell.Value) - iSpace) ' insert the "|" separator
            Else '"mail" was the first "info" -> search for the second "info" and place the "|" separator before it
                iDot = iAt + InStr(Right(cell.Value, Len(cell.Value) - iAt), ".") 'search for first 'dot' (".") after 'At' ("@"), to get near to the 'mail' info end
                iSpace = InStr(Right(cell.Value, Len(cell.Value) - iDot), " ") ' check for some more info at the left of 'mail' one (it should be separated by a 'space')
                If iSpace > 0 Then cell.Value = Mid(cell.Value, 1, iDot + iSpace - 1) & "|" & Mid(cell.Value, iDot + iSpace, Len(cell.Value) - (iDot + iSpace - 1))  ' if any more 'info' present, then insert the "|" separator
            End If
        End If

    Next cell

    'remove possible 'spaces' (" ") before or after "|" separator
    Application.DisplayAlerts = False
    .Replace what:=" |", Replacement:="|", lookAt:=xlPart, MatchCase:=False
    .Replace what:="| ", Replacement:="|", lookAt:=xlPart, MatchCase:=False
    Application.DisplayAlerts = True

    'parse info into two columns
    .TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
    TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"

'   keep 'Mail' info in first column and other info ('Tel') in second one
    Call ProcessData(.Cells, "MAIL")


    'now process the 'other' info column, in much the same way as done above
    With .Offset(, 1)

        'place "|" separator to mark possible 'Mobile' and 'Tel' info
        Application.DisplayAlerts = False
        .Replace what:="mobil", Replacement:="|Mobil", lookAt:=xlPart, MatchCase:=False 'Mark the 'Mobile' info, if any
        .Replace what:="tel", Replacement:="|Tel", lookAt:=xlPart, MatchCase:=False 'Mark the 'Tel' info, if any
        Application.DisplayAlerts = True

        'remove "|" separator if first character
        For Each cell In .Cells
            If Left(cell.Value, 1) = "|" Then cell.Value = Right(cell.Value, Len(cell.Value) - 1)
        Next cell

        'parse info into two columns
        .TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlSingleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|"

    '   keep 'Mobile' info in first column and other info ('Telephone') in second one
        Call ProcessData(.Cells, "MOB")

    End With

End With

End Sub

Sub ProcessData(dataRng As Range, keyStrng As String)
Dim data() As String
Dim j1 As Long, j2 As Long, i As Long
Dim cell As Range

    'fill Data() array with passed cells content keeping 'keyStrng' info in its first column and other info in its second column
    With dataRng.Resize(, 2)
        ReDim data(1 To .Rows.Count, 1 To 2)
        'loop through all their rows
        For i = 1 To .Rows.Count
            Set cell = .Rows(i).Find(what:=keyStrng, lookAt:=xlPart, LookIn:=xlValues, MatchCase:=False) 'search for 'mail' info
            If Not cell Is Nothing Then
                j1 = cell.Column - .Columns(1).Column + 1
                j2 = IIf(j1 = 1, 2, 1)
                data(i, 1) = .Cells(i, j1)
                data(i, 2) = .Cells(i, j2)
            Else
                data(i, 2) = .Rows(i).Range("A1")
            End If
        Next i
        .Cells = data
        .Columns.AutoFit
    End With

End Sub