|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
'按文件名做了一下排序(字符升序),再试一下
Option Explicit
Sub test()
Dim pos, filename(), n, arr, brr, sht, i, j, crr, temp
pos = Array(31, 79, 139, 220, 343, 514, 742, 1039, 1408, 1867, 2449, 3127, 3961)
If Not getfilename(filename, ThisWorkbook.Path, ".csv") Then Exit Sub
Application.ScreenUpdating = False
For Each sht In Sheets
Sheets(sht.Name).Cells.ClearContents
Next
ReDim crr(1 To UBound(filename), 1 To 2)
For i = 1 To UBound(filename)
crr(i, 1) = filename(i)
j = Split(filename(i), "\")
crr(i, 2) = j(UBound(j))
Next
temp = crr
Call msort(crr, temp, 1, UBound(filename), 1, 2, 2)
For i = 1 To UBound(filename)
filename(i) = crr(i, 1)
Next
For i = 1 To UBound(filename)
Open filename(i) For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
Close #1
n = n + 1
For j = 0 To UBound(pos)
brr = Split(arr(pos(j) - 1))
With Sheets("sheet" & j + 1)
.Cells(n + 1, "b").Resize(, UBound(brr) + 1) = brr
End With
Next j, i
Application.ScreenUpdating = True
End Sub
Function getfilename(filename, pth, mark) As Boolean
Dim f, n
If right(pth, 1) <> "\" Then pth = pth & "\"
f = Dir(pth & "*.*")
Do While Len(f) > 0
If LCase(right(f, Len(mark))) = LCase(mark) Then
n = n + 1: ReDim Preserve filename(1 To n)
filename(n) = pth & f
End If
f = Dir
Loop
If n > 0 Then getfilename = True
End Function
Function msort(arr, temp, first, last, left, right, key)
Dim i, j, k, kk, mid
If first <> last Then
mid = Int((first + last) / 2)
msort arr, temp, first, mid, left, right, key
msort arr, temp, mid + 1, last, left, right, key
i = first: j = mid + 1: k = first
While i <= mid And j <= last
If arr(i, key) <= arr(j, key) Then '改成>=就是降序
For kk = left To right: temp(k, kk) = arr(i, kk): Next
k = k + 1: i = i + 1
Else
For kk = left To right: temp(k, kk) = arr(j, kk): Next
k = k + 1: j = j + 1
End If
Wend
While i <= mid
For kk = left To right: temp(k, kk) = arr(i, kk): Next
k = k + 1: i = i + 1
Wend
While j <= last
For kk = left To right: temp(k, kk) = arr(j, kk): Next
k = k + 1: j = j + 1
Wend
For i = first To last
For j = left To right
arr(i, j) = temp(i, j)
Next j, i
End If
End Function |
|