Question

我想使用VBA Excel从文本文件中提取数据。文本文件（工程软件的输出）包含许多值。由于始终位于值之前的关键字，我可以找到我感兴趣的值。

以下是我的文本文件内容的典型示例：

random_text_before_keyword  [keyword1]       0.375    -0.080/   0.020      1.000
random_text_before_keyword  [keyword2]       0.530     0.367/   0.465      1.115
random_text_before_keyword  [keyword3]       0.363     0.200/   0.298      0.938
random_text_before_keyword  [keyword4]      19.225    21.206/   21.179     -71.834

一些困难：

关键字和值用随机空格分隔（有时还有标签）
值前面可以有＆＃34; - ＆＃34;签字（需要保留）
有时会出现＆＃34; /＆＃34;值后的字符（最好不要保留）
值不是整数（十进制数）
值的长度不一样

我的目标是在几行中提取四个值（例如[keyword1]和[keyword3]）并将它们放在Excel工作表中：

A1; B1; C1; D1
A2; B2; C2; D2

目前，我发现了一个与我可能需要做的事情非常接近的话题，但是我会非常感激。 using excel vba read and edit text file into excel sheet

Answer 1

用于测试以下功能：

Sub Tester()

    Dim l As String, arr, gotMatch As Boolean, v

    'you will be reading this from a file....
    l = "random_text_before_keyword  blahblah  " & vbTab & _
          "   0.530     0.367/   0.465      1.115 "

    arr = ProcessLine(l, "blahblah", gotMatch)

    If gotMatch Then
        For Each v In arr
            Debug.Print v
        Next v
    End If

End Sub

处理每一行的功能：

Function ProcessLine(line As String, keyword As String, ByRef gotMatch As Boolean)

    Dim rv As String, arr, v

    gotMatch = InStr(line, keyword) > 0

    If gotMatch Then

        rv = Split(line, keyword)(1) 'part after the keyword
        'clean up...
        rv = Replace(rv, vbTab, " ")
        rv = Replace(rv, "/", "")
        Do While InStr(rv, "  ") > 0
            rv = Replace(rv, "  ", " ")
        Loop

        arr = Split(Trim(rv), " ")

     End If 'has keyword

     ProcessLine = arr 'return array

End Function

编辑 - 修复了您的代码

rw = 1
myFile = "C:\vba\text.txt" 

Open myFile For Input As #1 

Do Until EOF(1) 

    Line Input #1, l 
    arr = ProcessLine(l, "[keyword1]", gotMatch) 

    If gotMatch Then 
        Cells(rw, 1).Resize(1, UBound(arr)+1).Value = arr 
        rw = rw + 1
    End If

Loop 

Close #1

Answer 2

虽然我建议在导入日期时将其拆分，但之后您可以使用此子目录进行拆分。我假设总有4个值，右边的5个单元格为空（将值放入）...原始单元格文本将保留（以检查错误）

Sub splitit()
  Dim startCell As Range
  Set startCell = Range("A1")
  Dim cellValue As Variant
  While startCell <> ""
    cellValue = startCell.Value
    cellValue = Trim(Replace(Replace(cellValue, "/", ""), vbTab, ""))
    While InStr(cellValue, "  ")
      cellValue = Replace(cellValue, "  ", " ")
    Wend
    cellValue = Split(cellValue, " ")
    startCell.Offset(0, 1) = cellValue(UBound(cellValue) - 4)
    startCell.Offset(0, 2) = cellValue(UBound(cellValue) - 3)
    startCell.Offset(0, 3) = cellValue(UBound(cellValue) - 2)
    startCell.Offset(0, 4) = cellValue(UBound(cellValue) - 1)
    startCell.Offset(0, 5) = cellValue(UBound(cellValue))
    'activate the next 2 lines to change the original cell to the first part without the extracted text
    'ReDim Preserve cellValue(LBound(cellValue) To UBound(cellValue) - 5)
    'startCell.Value = Join(cellValue, " ")
    Set startCell = startCell.Offset(1, 0)
  Wend
End Sub

尝试改进并将其与您的导入合并，以便将来自动执行...

Answer 3

这可能会让你前进。不得不做类似的事情。

步骤：

打开excel表。
按ALT-F11。
选择＆＃34;添加＆＃34;从菜单中。
选择＆＃34;模块＆＃34;来自下拉列表。
将以下来源复制到新创建的模块中。
更改Public Const声明后面的值以满足您的需求
运行CallImport

模块的简短说明：

FindRow - 搜索表中的关键字并返回找到关键字的单元格对象。

IsAnArry - 测试参数是否为Array类型。

CallImport - 开始导入的主子例程。

ImportEngineeringTextFile - 处理实际的导入和数据操作。

您需要更改的唯一内容是每个Public Const声明后面的值，以满足您的需要，而不是运行CallImport。在下面的代码中，我添加了一些注释，以帮助理解那里发生了什么。

-webkit-text-stroke-color: black;

从文本文件

3 个答案: