|
'代码放在"②SA_Conversion_填写指南.xlsm"工作簿中
Option Explicit
Sub test()
Dim arr, filename, i, j, t, n, pos, brr, crr
pos = Split("1-33 2-11 6-36 11-58 12-57") '选取列输出,自己修改
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
ReDim crr(1 To UBound(brr, 1) - 1, 1 To 17)
For i = 2 To n
For j = 0 To UBound(pos)
t = Split(pos(j), "-")
crr(i - 1, Val(t(0))) = brr(i, Val(t(1)))
Next j, i
With Sheets("input data")
.Rows(41).Resize(10 ^ 4).ClearContents '输出行,自己修改
.[a41].Resize(UBound(crr, 1), UBound(crr, 2)) = crr
End With
End Sub |
|