|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
'新建一个工作薄,其中有2个工作表名称分别为"sheet1"、"sheet2"
'一个为导出的源数据表,另外一个汇总后数据表(指定列)
'表格线等自己设置
Option Explicit
Sub test()
Dim arr, filename, i, j, t, n, pos, brr, dic, sum(1 To 3), m, tt, crr
pos = Split("33 36 37-77 54 57 64 65")
Set dic = CreateObject("scripting.dictionary")
filename = ThisWorkbook.Path & "\PKTA511(20171017).txt"
If Len(Dir(filename)) = 0 Then MsgBox filename: Exit Sub
Open filename For Input As #1
arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbNewLine)
Close #1
For i = 0 To UBound(arr)
If InStr(arr(i), vbTab) Then
n = n + 1: t = Split(arr(i), vbTab)
If n = 1 Then ReDim brr(1 To UBound(arr) + 1, 1 To UBound(t) + 1)
For j = 0 To UBound(t)
brr(n, j + 1) = t(j)
Next
End If
Next
With Sheets("sheet1")
.Cells.ClearContents
If n = 0 Then Exit Sub
.[a1].Resize(n, UBound(brr, 2)) = brr
End With
For i = 2 To n
t = CStr(brr(i, 33))
If Not dic.exists(t) Then m = m + 1: dic(t) = m
Next
ReDim crr(1 To m, 1 To 7)
For i = 2 To n
t = CStr(brr(i, 33))
For j = 0 To UBound(pos)
If j = 2 Then
tt = Split(pos(j), "-")
crr(dic(t), j + 1) = brr(i, tt(0)) & Space(2) & brr(i, tt(1))
ElseIf j = 4 Or j = 6 Then
crr(dic(t), j + 1) = crr(dic(t), j + 1) + Val(brr(i, pos(j)))
Else
crr(dic(t), j + 1) = brr(i, pos(j))
End If
Next
sum(1) = sum(1) + Val(brr(i, pos(4))): sum(3) = sum(3) + Val(brr(i, pos(6)))
Next
With Sheets("sheet2")
.Rows(2).Resize(Rows.Count - 1).ClearContents
.[a2].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
n = .Cells(Rows.Count, "a").End(xlUp).Row
.Cells(n + 1, 5).Resize(, UBound(sum)) = sum
End With
End Sub |
评分
-
1
查看全部评分
-
|