0

I'm trying to create a macro to import a .txt file into excel and fill in column A. Each word in the text file should have its own row. So far I have code which will allow the user to select a .txt file, reads it, and writes each word in its own cell. It does not, however, start a new row with each word. Any and all help is appreciated. Thanks!

I'm starting with simple text files, though it would be nice to know how to edit out all punctuation as well when importing. (see two examples below)

EX1: "The quick brown
fox jumped over
the lazy moon"

EX2: "The quick.
brown fox,
jumped over the?
lazy moon"

And my code...

Sub TextImport()
Dim fileToOpen As String

Worksheets("Dictionary").Activate
Application.ScreenUpdating = False

Range("a:z").Delete

fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Select a file to import")

If fileToOpen <> "" Then
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
        & fileToOpen, Destination:=Range("A1"))

        .Name = "mytext"

        .FieldNames = True
        .RowNumbers = False

        .FillAdjacentFormulas = False
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileSpaceDelimiter = True

        .Refresh BackgroundQuery:=False
    End With
End If

Application.ScreenUpdating = False
End Sub
4

1 に答える 1

1 
Sub ListWords()
    Dim re As Object
    Dim s As String, matches As Object, match As Object
    Dim rngList As Range

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "([a-z]+)"
    re.ignorecase = True
    re.Global = True

    Set rngList = ThisWorkbook.Sheets("Sheet1").Range("A1")
    s = GetContent("C:\blahblah\tmp.txt")

    Set matches = re.Execute(s)
    If Not matches Is Nothing Then
       For Each match In matches
            rngList.Value = match.Value
            Set rngList = rngList.Offset(1, 0)
       Next match
    End If

End Sub

Function GetContent(f As String)
    GetContent = CreateObject("scripting.filesystemobject"). _
                    opentextfile(f, 1).readall()
End Function
于 2013-02-26T22:05:18.943 に答える