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宏按字讀取文本文件並將每個單詞寫入同一列中的新單元格

回答

相關問題