1. 数据源
金字塔导出的持仓文件格式:
序号 品种 均价 今持 总持 市价 浮动盈亏 保证金 风险度 投保 账户
1 ZN02 沪锌1602 12695 1 1 1660 -175.00 712.75 0.0529 投机 88888888
2 RB03 螺纹钢1603 1653 -1 -1 1651 80.00 950.80 0.0551 投机 88888888
3 P04 棕榈1604 4652 -1 3694 -420.00 0.00 0.0000 投机 88888888
4 C04 玉米1604 1841 1 1873 320.00 196.80 0.0139 投机 88888888
5 MA04 甲醇1604 1642 -1 1626 160.00 161.00 0.0150 投机 88888888
方法一: 一开始考虑用excel导入的方式,分割方式为定长(xlFixedWidth) ,取数比较方便,直接在vba里用sheet.cells(i,j)取即可。
On Error Resume Next
Application.ScreenUpdating = False
mainfile = Application.ActiveWorkbook.Name
Workbooks(mainfile).Worksheets.Add after:=Worksheets(Worksheets.Count) '在最后面添加一个工作表
Set newSh = ActiveSheet
'ActiveSheet.Name = "test"
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
' .AllowMultiSelect = True
If .Show = -1 Then
For Each file In .SelectedItems
b = Split(Replace(file, ".txt", ""), "\")
'Workbooks.OpenText Filename:=file, Origin:=936, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True, Other:=False
Workbooks.OpenText Filename:=file, Origin:=936, DataType:=xlFixedWidth, Other:=False
ActiveSheet.UsedRange.Copy newSh.[a1]
newSh.UsedRange.Font.Size = 10
'newSh.Name = b(UBound(b)) '导入文件名
ActiveWorkbook.Close False
Next
Else
Application.DisplayAlerts = False '避免删除警告
newSh.Delete
Set newSh = Nothing
Application.DisplayAlerts = True '重新打开
End If
End With
使用例子:
按照某几列重新排序
tmpSh.Range("A1").Sort Key1:=tmpSh.Columns("B"), Key2:=tmpSh.Columns("C"), Header:=xlYes
取持仓文件的市场价(因收盘后导出等于收盘价)
mainsh.Cells(mRow + 3, mCol + k - 1).Value = tmpSh.Cells(i, eCol).Value '今日收盘价
If tmpSh.Cells(i, eCol - 1).Value < 0 Then '总持 负数表示空
' mainsh.Cells(mRow + 10, mcol + k - 1).Value = tmpsh.Cells(i, 5).Value
qCol(k).iCKShort = tmpSh.Cells(i, eCol - 1).Value '总持 空
Else
' mainsh.Cells(mRow + 11, mcol + k - 1).Value = tmpsh.Cells(i, 5).Value
qCol(k).iCKLong = tmpSh.Cells(i, eCol - 1).Value '总持 多
End If
方法二: 纯vb方法
myfile = Application.GetOpenFilename()
Open myfile For Input As 1#
If EOF(1) Then Exit Sub
Line Input #1, textline
iPinzhong = LenB(StrConv(Left(textline, InStr(textline, ("品种")) - 1), vbFromUnicode))
iJunJia = LenB(StrConv(Left(textline, InStr(textline, ("均价")) - 1), vbFromUnicode)) 'InStr(textline, "均价")
iZongchi = LenB(StrConv(Left(textline, InStr(textline, ("总持")) - 1), vbFromUnicode)) 'InStr(textline, "总持")
iShijia = LenB(StrConv(Left(textline, InStr(textline, ("市价")) - 1), vbFromUnicode)) ' InStr(textline, "市价")
Do Until EOF(1)
Line Input #1, textline
Dim b() As Byte
b = StrConv(textline, vbFromUnicode)
MySelect.Parent.Cells(r, c) = StrConv(SubArray(b, iPinzhong, iJunJia - iPinzhong), vbUnicode): MySelect.Parent.Cells(r, c).NumberFormatLocal = "G/通用格式"
MySelect.Parent.Cells(r, c + 1) = StrConv(SubArray(b, iZongchi, iShijia - iZongchi), vbUnicode): MySelect.Parent.Cells(r, c + 1).NumberFormatLocal = "G/通用格式"
r = r + 1
Loop
调用子函数 (截取byte数组的子数组)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Function SubArray(byt() As Byte, ByVal iStart As Long, ByVal iLen As Long) As Byte()
Dim buf() As Byte
ReDim buf(iLen - 1) As Byte
' 这里byt(0)和byt(iStart)传进去的是地址
CopyMemory buf(0), byt(iStart), iLen
SubArray = buf
End Function
因为VB(或者VB)对字符的处理为Unicode,中文与数字的长度都是1,而实际上文本里对齐是因为中文占了2个位置而数字英文都只占了1个位置。
故先使用StrConv (见以前文章)转化为字节数组,再取其长度。