Question

我真的希望能得到你的帮助。我一直在寻找可能是一个简单解决方案的高低。

我们有数百个与cnc程序相关的txt文件。不幸的是，在保持零件和操作的严格编号系统方面，历史上缺乏控制。

我必须将每个文件的第3行和第4行提取到excel文档中，以便我们可以为一些文件提供报酬，并将所有文件编入目录。

到目前为止，我发现最接近我所追求的是在线程中

Extract a single line of data from numerous text files and import into Excel

然而我无法使它工作 - 我的excel知识很好但不是宏。每个txt文件的开头是

#1 <blank line>
#2 %
#3 O00000 (part description)
#4 (part descriptio)
#5 rest of program.

。。。根据要求我已经包含了我试图修改的代码。

Private Sub CommandButton1_Click()
    Dim filename As String, nextrow As Long, MyFolder As String
    Dim MyFile As String, text As String, textline As String, prog As String

    MyFolder = "M:\CNC Programs\Haas lathe programs\Haas ST30 programs\Programs\Programs in .txt format"
    MyFile = Dir(MyFolder & "*.txt")

    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
            Line Input #3, textline
            text = text & textline 
        Loop
        Close #1
        MyFile = Dir()
        Debug.Print text
        nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheet1.Cells(nextrow, "A").Value = Mid(text, prog)
        text = "" 'reset text
    Loop
End Sub

Answer 1

由于您对vba没有太多经验，以下是您可能想要谷歌并将结果放在一起的一些要点

在Excel VBA中打开文本文件（您应该从中开始，并尝试读取一个文件）
使用Excel VBA循环浏览某个文件夹中的所有文件

您的代码需要执行以下操作。

获取您要加载的所有文件的列表
打开该列表的每个文件
从该文件中读取第3行和第4行
将行复制到excel。

一旦你学会了如何搜索

，互联网上有很多例子

Answer 2

经过几个小时和一位朋友的帮助后我们想出了这个，或多或少地做了我需要的东西。

我知道我想如何改进它，我只需要现在解决这个问题。再一次，我确定这是一个简单的伎俩。毅力!!!

如果可以的话，我现在要做的就是拿我的目录
＆＃39; M：\ CNC程序\ Haas Mills程序\所有Mill程序.txt格式\＆＃39; 并扫描所有后续文件夹中的.txt文件，并将相同的信息提取到工作簿中。

如果我弄明白，我会再次更新帖子。谢谢你让我走上正确的道路8号先生。

Private Sub CommandButton1_Click()
  Dim MyMask As String, nextrow As Long, MyFolder As String
  Dim MyFile As String, text As String, textline As String
  Dim posCommentStart As String, posCommentFinish
  Dim iLine As Integer

MyFolder = "M:\CNC Programs\Haas Mills programs\All Mill Programs .txt format\HAAS MINI-MILL BALLPADS & BALLPINS\"
MyMask = MyFolder & "*.txt"
MyFile = Dir(MyMask)

Do While MyFile <> ""
    iLine = 0
    Open (MyFolder & MyFile) For Input As #1
    Do Until EOF(1) Or iLine >= 4
        iLine = iLine + 1
        Line Input #1, textline
        If iLine >= 3 Then
           text = text & textline 'second loop text is already stored -> see reset text
        End If

    Loop
    Close #1
    MyFile = Dir()
    Debug.Print text

    posCommentStart = InStr(text, "(")
    posCommentFinish = InStr(text, ")")

    If posCommentStart > 0 Then

        nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

        ActiveSheet.Cells(nextrow, "A").Value = Left(text, posCommentStart - 2)
        ActiveSheet.Cells(nextrow, "B").Value = Mid(text, posCommentStart +        1, posCommentFinish - posCommentStart - 1)

    End If

    text = "" 'reset text

Loop
End Sub

从.txt文件的文件夹中提取单行数据到excel

2 个答案: