Question

我正在使用excel表包含1000个条目。 我想在一个单元格中分配电话号码和电子邮件。
我使用数据选项卡选项，但有些行有，来分隔，有些行有空格来分隔电话和电子邮件。

B列中的数据与

相同

电话：05164/801623美孚：0171/2337496邮箱：Irisahlden（at）web（dot）de

电子邮件：irj @ gmail.com，Telefon：3927-743627

Tele：45937/28627电子邮件：hurjd@hotmail.com

有没有办法在不同的单元格中分隔电子邮件和电话？

Answer 1

您可以通过以下方式将数字从单元格中拆分出来，如果您希望包含这些数字，则必须在其中为分隔符添加一些检查。请参阅：How to find numbers from a string?

电子邮件地址，您最好搜索＆＃34; @＆＃34;或＆＃34;（at）＆＃34;在字符串中，然后取出前后的所有字符，直到找到空格。或者，为了使搜索更容易，替换所有＆＃34;（at）＆＃34;和＆＃34;（点）＆＃34;与＆＃34; @＆＃34;和＆＃34;。＆＃34;。请参阅：Check if a string contains another string

希望这有帮助。

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

在excel中找到特定单词时在单元格中拆分字符串

2 个答案: