如何用VBA提取文本文件（*.TXT),提取指定位置数据或字符串

天宇130

请高手帮忙看看！

hlrong

我觉得问题的难点不在从文本文件是提取相应数据，最大的难点在于如何把1500多只股票中的文本取出来，这是个在耗时耗力的事情，况且作为A股市场，财务分析，持仓分析不是那么有用的。

天宇130

只要按要求把数据提出来就可以。。。

请高手帮忙。。。

office2008

其实已经求出来了，后面的提取应该不难了，用字典就可以了。

天宇130

请高手给一下代码。。。谢谢！！！

office2008

Sub yy()

    Dim sr As String, fd As Boolean, l As Integer, i As Integer
    Dim arr() As String, z As Integer, gt As Boolean, arr2() As Variant, arr3() As Variant
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set d = CreateObject("scripting.dictionary")
    Range("a1:j10000").Clear
    oPath = ThisWorkbook.Path & "\"
    Filename = Dir(oPath & "*.txt")
    Do While Filename <> ""
        Open oPath & Filename For Input As #1
        Do While Not EOF(1)
            Line Input #1, sr
            If InStr(sr, "主力持仓统计") Then fd = True: gt = True: w = w + 1
            If fd Then
                If sr <> "" Then
                    If InStr(sr, "─") = 0 And InStr(sr, "━") = 0 Then
                        If InStr(sr, "【") Then
                            Range("a1") = sr
                        Else
                            l = l + 1
                            z = UBound(Split(sr, "│"))
                            ReDim Preserve arr(0 To z, 1 To l + 1)
                            If gt Then arr(z, l) = "'" & Left(Filename, Len(Filename) - 4): gt = False
                            For i = 0 To z
                                arr(i, l + 1) = Trim(Replace(Split(sr, "│")(i), "-", ""))
                                If arr(0, l + 1) = "报告期" Then
                                    If i > 0 Then
                                        If Not d.exists(arr(i, l + 1)) Then
                                            k = k + 1
                                            d(arr(i, l + 1)) = k
                                        End If
                                    End If
                                ElseIf arr(0, l + 1) <> "占流通比(%)" Then
                                    If Not d.exists(arr(0, l + 1)) Then
                                        x = x + 1
                                        d(arr(0, l + 1)) = x
                                        ReDim Preserve arr2(1 To x)
                                    End If
                                End If
                            Next
                        End If
                    End If
                Else
                    Exit Do
                End If
            End If
        Loop
        l = l + 2
        fd = False
        Close #1
        Filename = Dir()
    Loop
    Range("a2").Resize(UBound(arr, 2), z + 1) = Application.Transpose(arr)
    ReDim arr3(1 To w + 2, 1 To k + 1)
    For i = 1 To x
        arr2(i) = arr3
    Next
    For i = 2 To UBound(arr, 2)
        If arr(0, i) = "报告期" Then
            y = y + 1
            m = i
        ElseIf arr(0, i) <> "占流通比(%)" Then
            If d.exists(arr(0, i)) Then
                arr2(d(arr(0, i)))(1, 1) = arr(0, i) & "流通比(%)"
                arr2(d(arr(0, i)))(2, 1) = "报告期"
                arr2(d(arr(0, i)))(y + 2, 1) = arr(UBound(arr), m - 1)
                For j = 1 To UBound(arr)
                    arr2(d(arr(0, i)))(2, d(arr(j, m)) + 1) = arr(j, m)
                    arr2(d(arr(0, i)))(y + 2, d(arr(j, m)) + 1) = arr(j, i + 1)
                Next
            End If
        End If
    Next
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "数据提取" Then Sheets(i).Delete
    Next
    For i = 1 To x
        sheetname = Replace(arr2(i)(1, 1), "流通比(%)", "") & "汇总"
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = sheetname
        Sheets(sheetname).Range("a1").Resize(UBound(arr2(i)), k + 1) = arr2(i)
    Next
    Sheets("数据提取").Select
    Application.ScreenUpdating = True
End Sub


Sub cls()
    Application.DisplayAlerts = False
    Range("a1:j10000").Clear
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> "数据提取" Then Sheets(i).Delete
    Next
End Sub

zklwf

你解决的"如何用VBA提取文本文件（*.TXT),提取指定位置数据或字符串"非常好，我也遇到同样的问题，比他的各单位的多了。我本身也写了，但运行太慢，请帮助用你的方法解决一下。附件及说明放在，“如何用VBA提取文本文件（*.TXT),提取指定位置数据或字符串”贴的最下面

littlegend

提取指定字符的部分，你可以使用批处理（bat）来做，完成之后复制到excel或者导入都可以

天宇130

非常感谢！

fxzg

学习 好好的学习