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

-1

我有一个巨大的txt文件，其中包含由电子邮件ID分隔的,（空间）或;或这些的组合。Excel宏按字读取文本文件并将每个单词写入同一列中的新单元格

我想将这些电子邮件ID分开，并将它们写入到一个列中的新单元格中，在Excel文件中逐行排列。

Excel分隔的导入无法显示所有ID，因为只有256列。我已经遇到了数千个单词。并且最适合于逐行插入到同一列的新单元格中。

输入文本文件的样子：

[email protected]; [email protected], [email protected], [email protected]

需要输出到Excel文件：

[email protected] 
[email protected] 
[email protected] 
[email protected]

来源

2012-10-12 Vivek Ganapathy

你到目前为止尝试过什么？一个好的开始可能是[FAQ]（http://stackoverflow.com/faq）或[互联网]（http://www.google.com）。 –

查看的内容：_file i/o_，_split_和_entering text in cells _... :) –

@OlleSjögren - 我试过了所有的stackoverflow和互联网了，试了几个我在网上找到的代码，我有非常有限的编程知识，我是专业摄影师，这是我现实生活中的问题...我已经做了一些非常基本的VB编程大约15年前，并试图看看是否会帮助..我'我肯定这是可能的，只是我没有配备编程天赋。 –

参考：http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_1480-How-to-Split-a-String-with-Multiple-Delimiters-in-VBA.html

你的问题包含几个部分

1.Read txt文件转换为字符串（Excel有字符串限制）我试过接收一个错误消息“串出空间”，所以我希望你的“庞大”的文件是不是> 1G什么

2.Split他们通过辑阵，分隔符

每行

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

来源

2012-10-12 09:19:54 Larry

非常感谢您的代码。它像梦一样工作:)欣赏你的时间和快速回复。欢呼 –

希望你能从这个例子中学到一些东西 – Larry

是的，我试图现在解剖代码并逆向工程逻辑。欣赏它，欢呼声:) –

另一种方式：

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

编辑按照建议，我已经更新上面的对付个连续m ixed分隔符（，;）所以上述将允许类似的东西：

[email protected]; [email protected], [email protected], [email protected];,;,; [email protected];; [email protected],,; [email protected], [email protected]

来源

2012-10-12 10:14:58 SWa

明确，我只是坚持这个问题“或这些的组合。” – Larry

好点;）更新以处理连续的，混合的分隔符（只要它们是;或其组合） – SWa

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

回答

相关问题