Question

我正在尝试创建一个宏来将.txt文件导入excel并填写A列。文本文件中的每个单词都应该有自己的行。到目前为止，我有一些代码，允许用户选择.txt文件，读取它，并将每个单词写入自己的单元格。但是，它不会为每个单词开始一个新行。任何和所有的帮助表示赞赏。谢谢！

我从简单的文本文件开始，虽然在导入时知道如何编辑所有标点符号会很好。（见下面的两个例子）

EX1：“快棕褐色狐狸跳了过来懒月“

EX2：“快。” 棕色狐狸，
跳了过来？
懒月“

我的代码......

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

Answer 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

VBA导入文本文件，其中每个单词都有自己的行

1 个答案: