使用VBA将文本文件中的精确信息转换为Excel列

时间:2015-11-14 23:15:09

标签: excel vba excel-vba

[在此输入链接说明] [1]我试图搜索此文本文件中的特定单词,以便在Excel列中输出它的行内容。文本文件包含多个部分。我能够输出文本文件的第一部分但由于某些原因我无法定义循环,因此我可以检索文件的每个部分。

到目前为止我的代码:

Sub test()
Dim myFile As String, text As String, textline As String, DDC As Integer, DDR As Integer, DDP As Integer, ADC As Integer, i As Integer, SE As Integer, SP As Integer, SG As Integer, j As Integer, v As Integer

myFile = "C:\Users\Seb\Desktop\text2.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
 text = text & textline
Loop
Close #1

i = 1

    DDC = InStr(text, "Date de calcul")
    DDR = InStr(text, "Date de retraite")
    ADC = InStr(text, "Âge à la date du calcul")
    SE = InStr(text, "Service d'emploi")
    SP = InStr(text, "Service de participation")
    SG = InStr(text, "Salaire gagné")
    Cells(i + 1, 1).Value = Mid(text, DDC, 14)
    Cells(i + 1, 2).Value = Mid(text, DDC + 36, 10)
    Cells(i + 2, 1).Value = Mid(text, DDR, 16)
    Cells(i + 2, 2).Value = Mid(text, DDR + 36, 10)
    Cells(i + 3, 1).Value = Mid(text, ADC, 23)
    Cells(i + 3, 2).Value = Mid(text, ADC + 36, 6)
    Cells(i + 4, 1).Value = Mid(text, SE, 16)
    Cells(i + 4, 2).Value = Mid(text, SE + 36, 6)
    Cells(i + 5, 1).Value = Mid(text, SP, 24)
    Cells(i + 5, 2).Value = Mid(text, SP + 36, 6)
    For v = 0 To 10
    j = v * 228
    Cells(v + 7, 1).Value = Mid(text, SG + j, 24) + Mid(text, SG + 64 + j,     10) + "/ " + Mid(text, SG + 77 + j, 10)
    Cells(v + 7, 2).Value = Mid(text, SG + 103 + j, 10)
    Next v

End Sub

我的文本文件的例子可以在这里找到:http://txt.do/5j2dq

正如我之前提到的,我只能输出excel中的第1部分。我的代码应该是什么,以便检索我的文本文件的每个部分?

2 个答案:

答案 0 :(得分:0)

在您覆盖每个部分后,只需从text字符串中删除已覆盖的部分,以便在下一次迭代中,例如InStr(text, "Date 1")会找到下一部分的Date 1行。

Do While True
    DDC = InStr(text, "Date 1")
    If DDC = 0 Then
        ' no more sections - exit loop
        Exit Do
    End If
    DDR = InStr(text, "Date 2")
    ADC = InStr(text, "Age")
    ' ......

    Next v

    ' remove the section that was just handled
    text = Mid(text, SG + 30)
Loop

答案 1 :(得分:0)

如果您将TXT文件作为数据►外部数据►来自文本,您可以将句点设置为其他分隔符(将连续分隔符视为一个为True )。

Sub Import_Text()
    Dim c As Long, myFile As String

    myFile = "C:\Users\Seb\Desktop\text.txt"

    With Worksheets("Sheet9")   '<~~set this worksheet reference properly!

        With .QueryTables.Add(Connection:="TEXT;" & myFile, _
            Destination:=Range("$A$1"))
            .Name = "TXT"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "."
            .TextFileColumnDataTypes = Array(1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        'these will cleanup (trim) the results
        For c = 1 To 2
            With .Columns(c)
                .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
                               FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
            End With
        Next c

    End With
End Sub

有两个最终Range.TextToColumns method xlFixedWidth选项,可以简单地从结果中删除任何流氓领先/栏杆空格。