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

Question

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

數據在B列是相同

電話：05164/801623手機：0171/2337496郵箱：Irisahlden（AT）網站（點）去

電子郵件：IRJ @ gmail的.COM，電話：3927-743627

長焦：二萬八千六百二十七分之四萬五千九百三十七電子郵件：hurjd@hotmail.com

有沒有辦法，我在不同的細胞中分離的電子郵件和電話什麼辦法？

Answer 1

您可以通過以下操作將數字拆分出單元格，如果您希望包含它們，則必須在該單元格中添加一些檢查。請參閱：How to find numbers from a string?

電子郵件地址，您最好在字符串中搜索「@」或「（at）」，然後取得前後所有字符，直到找到空格。 或者，爲使搜索更容易，請用「@」和「。」替換所有「（at）」和「（dot）」。 見：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