Excel宏逐字读取文本文件，并将每个字写入同一列中的新单元格

我有一个巨大的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有字符串限制）我试图收到一条错误消息“字符串空间不足”，所以我希望您的“大”文件不是>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

子测试（）
作为字符串的Dim fname
作为字符串的Dim sVal
不算长
将ws设置为工作表
设置ws=Worksheets（“Sheet2”）“将Sheet1替换为所需的输出图纸名称
fname=“H:\My Documents\a.txt”'将路径替换为txt文件路径
sVal=OpenTextFileToString2（fname）
Dim tmp作为变体
tmp=SplitMultiDelims（sVal，，；，，True）'将第二个参数与需要使用的分隔符列表放在一起
计数=0
对于i=LBound（tmp，1）到UBound（tmp，1）
计数=计数+1
ws.Cells（count，1）=第一列上的tmp（i）'输出
接下来我
端接头
函数OpenTextFileToString2（ByVal strFile作为字符串）作为字符串
“RB Smissaert-作者
暗文件一样长
hFile=FreeFile
打开strFile作为#hFile输入
OpenTextFileToString=Input$（LOF（hFile），hFile）
关闭#h文件
端函数
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
“阿兰布莱登的《斯普利姆》
'此函数将文本拆分为子字符串数组，每个子字符串
'由DelimChars中的任何字符分隔。只有一个字符
'可以是两个子字符串之间的分隔符，但DelimChars可以
'包含任意数量的分隔符字符。它返回单个元素
'如果DelimChars为空，则包含所有文本的数组，或大于等于1的数组
'元素数组，如果文本成功拆分为子字符串。
'如果IgnoreConsutiveDelimiters为true，则不会出现空数组元素。
'如果Limit大于0，函数将只将文本拆分为'Limit'
'数组元素或更少。最后一个元素将包含文本的其余部分。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
函数SplitMultiDelims（ByRef文本作为字符串，ByRef DelimChars作为字符串_
可选的ByVal IgnoreConsutiveDelimiters为布尔值=False_
可选的ByVal限制，长度=-1）为String（）
Dim ElemStart等长，N等长，M等长，元素等长
将lDelims变长，将lText变长
Dim Arr（）作为字符串
lText=Len（文本）
lDelims=Len（DelimChars）
如果lDelims=0或lText=0或Limit=1，则
重拨Arr（0到0）
Arr（0）=文本
SplitMultiDelims=Arr
退出功能
如果结束
ReDim Arr（0到IIf（极限=-1，lText-1，极限））
元素=0:ElemStart=1
对于N=1到lText
如果仪表（DelimChars，Mid（文本，N，1））则
Arr（Elements）=Mid（Text，ElemStart，N-ElemStart）
如果忽略连续的删除，则
如果Len（Arr（Elements））>0，则Elements=Elements+1
其他的
元素=元素+1
如果结束
ElemStart=N+1
如果元素+1=限制，则退出
如果结束
下一个
'将字符串末尾终止的最后一个标记获取到数组中
如果ElemStart采用另一种方式：

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

到目前为止你试过什么？一个好的开始可以是或。要查找的内容：文件i/o、拆分和在单元格中输入文本…：）@OlleSjögren--我也在stackoverflow和互联网上尝试过，尝试过在网上找到的一些代码，我的编程知识非常有限，我是一名专业摄影师，这是我在现实生活中遇到的问题。。。大约15年前，我做过一些非常基本的VB编程，并试图看看这是否有帮助。。我相信这是可能的，只是我并没有编程天赋。你们也可以尝试一个好的文本编辑器，使用搜索和替换来去除分隔符，并将每条记录放在自己的行上。对于非程序员来说可能更快一些？很多优秀的免费编辑器。非常感谢你的代码。这就像一场梦：）感谢你的时间和快速回复。谢谢，我现在正试图剖析代码，并对逻辑进行反向工程。感谢你，干杯：）明白一点，我只是坚持这个问题“或者这些问题的组合。”好的观点；）更新以处理连续的、混合的分隔符（只要是，；或它们的组合）