, 我有一个巨大的 txt 文件，其电子邮件 ID 由（空格）、或;、或这些的组合分隔。
我想将这些电子邮件 ID 分开并将它们写入 Excel 文件中一行接一行的一列中的新单元格中。
Excel 的分隔导入无法显示所有 id，因为只有 256 列。而我遇到的单词数有数千个。并且最适合逐行插入到同一列的新单元格中。
输入文本文件如下所示：
abc@abc.com; xyx@xyc.com, ext@124.de, abcd@cycd.com
需要输出到excel文件：
abc@abc.com
xyx@xyc.com
ext@124.de
abcd@cycd.com
您的问题包含几个部分
1.将txt文件读成字符串（Excel有字符串限制）我试过收到错误消息“Out of String Space”，所以我希望你的“Huge”文件不是> 1G之类的
2.用多重分隔符分割它们
3.每行输出邮件
Sub Testing()
Dim fname As String
Dim sVal As String
Dim count As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") 'Replace Sheet1 with the output sheet name you want
fname = "H:\My Documents\a.txt" 'Replace the path with your txt file path
sVal = OpenTextFileToString2(fname)
Dim tmp As Variant
tmp = SplitMultiDelims(sVal, ",; ", True) ' Place the 2nd argument with the list of delimiter you need to use
count = 0
For i = LBound(tmp, 1) To UBound(tmp, 1)
count = count + 1
ws.Cells(count, 1) = tmp(i) 'output on the first column
Next i
End Sub
Function OpenTextFileToString2(ByVal strFile As String) As String
' RB Smissaert - Author
Dim hFile As Long
hFile = FreeFile
Open strFile For Input As #hFile
OpenTextFileToString2 = Input$(LOF(hFile), hFile)
Close #hFile
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelims by alainbryden
' This function splits Text into an array of substrings, each substring
' delimited by any character in DelimChars. Only a single character
' may be a delimiter between two substrings, but DelimChars may
' contain any number of delimiter characters. It returns a single element
' array containing all of text if DelimChars is empty, or a 1 or greater
' element array if the Text is successfully split into substrings.
' If IgnoreConsecutiveDelimiters is true, empty array elements will not occur.
' If Limit greater than 0, the function will only split Text into 'Limit'
' array elements or less. The last element will contain the rest of Text.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SplitMultiDelims(ByRef Text As String, ByRef DelimChars As String, _
Optional ByVal IgnoreConsecutiveDelimiters As Boolean = False, _
Optional ByVal Limit As Long = -1) As String()
Dim ElemStart As Long, N As Long, M As Long, Elements As Long
Dim lDelims As Long, lText As Long
Dim Arr() As String
lText = Len(Text)
lDelims = Len(DelimChars)
If lDelims = 0 Or lText = 0 Or Limit = 1 Then
ReDim Arr(0 To 0)
Arr(0) = Text
SplitMultiDelims = Arr
Exit Function
End If
ReDim Arr(0 To IIf(Limit = -1, lText - 1, Limit))
Elements = 0: ElemStart = 1
For N = 1 To lText
If InStr(DelimChars, Mid(Text, N, 1)) Then
Arr(Elements) = Mid(Text, ElemStart, N - ElemStart)
If IgnoreConsecutiveDelimiters Then
If Len(Arr(Elements)) > 0 Then Elements = Elements + 1
Else
Elements = Elements + 1
End If
ElemStart = N + 1
If Elements + 1 = Limit Then Exit For
End If
Next N
'Get the last token terminated by the end of the string into the array
If ElemStart <= lText Then Arr(Elements) = Mid(Text, ElemStart)
'Since the end of string counts as the terminating delimiter, if the last character
'was also a delimiter, we treat the two as consecutive, and so ignore the last elemnent
If IgnoreConsecutiveDelimiters Then If Len(Arr(Elements)) = 0 Then Elements = Elements - 1
ReDim Preserve Arr(0 To Elements) 'Chop off unused array elements
SplitMultiDelims = Arr
End Function
另一种方式：
Sub importText()
Const theFile As String = "Your File Path"
Dim rng
Open theFile For Input As #1
rng = Application.Transpose(Filter(Split(Replace(Replace(Input(LOF(1), 1), " ", ""), ",", ";"), ";"), "@"))
Close
Sheets(1).Cells(1, 1).Resize(UBound(rng)).Value = rng
End Sub
编辑 根据建议，我已经更新了上面的内容以处理连续的混合分隔符 (,;) 所以上面将允许类似：
abc@abc.com; xyx@xyc.com, ext@124.de, abcd@cycd.com;,;,; abc@abc.com;; xyx@xyc.com,,; ext@124.de, abcd@cycd.com