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
2009-5-7 09:53 上传
点击文件名下载附件
217.7 KB, 下载次数: 274