2

我正在从 .txt 文件中读取信息，该文本文件有 2 行和 6 列；每个元素由空格或制表符分隔。我有数据可以读取所有字符串，但我发现很难将数据放入单元格。我怎样才能找到第一行的结尾。

文本文件：

$SUBCASE       1                             1
$DISP          0     509       5       1     2

下面是完整的代码，我只得到第一个字符串，其余的没有......

Private Sub PCH_Click()
Dim arTemp() As Variant
Dim lRet As String
Dim sVal As String
Dim Row As Long
Dim Col As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'Default method Uses Open Dialog To Show the Files
lRet = Application.GetOpenFilename("PCH files (*.pch), *.*")
'Reads the file into characters
sVal = OpenTextFileToString2(lRet)
Dim tmp As Variant
    tmp = SplitMultiDelims(sVal, ",;$ ", True)   ' Place the 2nd argument with the list of delimiter you need to use
    Row = 0
    For i = LBound(tmp, 1) To UBound(tmp, 1)
        Row = Row + 1
        Col = 1
        While Not vbNewLine = ""
            ws.Cells(Row, Col) = tmp(i)  'output on the first column
            MsgBox (tmp(i))
            Col = Col + 1
        Wend
    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
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
4

1 回答 1

0

您可以使用以下代码逐行读取文件

Sub IOTest()
    Dim fnum, i As Integer, j As Integer
    Dim line    As String
    Dim lines   As Variant

    Dim regEx   As Object
    Set regEx = CreateObject("vbscript.regexp")

    With regEx
        .Pattern = "\s{1}"  'only one whitespace
        .Global = True      'find all occurrences
    End With

    fnum = FreeFile()
    Open ThisWorkbook.Path & "\IO_Test.txt" For Input As #fnum

    Do Until EOF(fnum)      'until End of file
        i = i + 1
        Input #fnum, line   'load row into line

        'First replace found sole whitespaces with ","
        'Then split on the ","s
        lines = Split(regEx.Replace(line, ","), ",")
        For j = LBound(lines) To UBound(lines)
            Cells(i, j + 1) = lines(j)
        Next j
    Loop
    Close #fnum
End Sub

我用字符串测试了这个

"$SUBCASE" & vbTab & "1" & vbTab & vbTab & vbTab & vbTab & "1"
"$DISP" & vbTab & "0" & vbTab & "509" & vbTab & "5" & vbTab & "1" & vbTab & "2"

只有当您有一个空格（例如空格，制表符，...）分隔数据时，它才有效。如果数据之间有多个空格，则会变得更加棘手。但是，如果您可以提供有关如何分离数据的示例，我可以看一下。

我希望它有帮助，让我知道任何一种方式;）

于 2013-07-23T10:24:17.040 回答