[VBA] 处理中英文对齐的文本

1. 数据源金字塔导出的持仓文件格式：

序号    品种               均价     今持    总持    市价     浮动盈亏    保证金     风险度    投保    账户1       ZN02 沪锌1602      12695    1       1       1660     -175.00     712.75     0.0529    投机    888888882       RB03 螺纹钢1603    1653     -1      -1      1651     80.00       950.80     0.0551    投机    888888883       P04 棕榈1604       4652             -1      3694     -420.00     0.00       0.0000    投机    888888884       C04 玉米1604       1841             1       1873     320.00      196.80     0.0139    投机    888888885       MA04 甲醇1604      1642             -1      1626     160.00      161.00     0.0150    投机    88888888

可以看到该文件以空格为分隔符，且同一列为左对齐，根据不同的需要我们需要取值不同的字段做分析处理。方法一： 一开始考虑用excel导入的方式，分割方式为定长(xlFixedWidth) ，取数比较方便，直接在vba里用sheet.cells(i,j)取即可。

  On Error Resume NextApplication.ScreenUpdating = Falsemainfile = Application.ActiveWorkbook.NameWorkbooks(mainfile).Worksheets.Add after:=Worksheets(Worksheets.Count) '在最后面添加一个工作表Set newSh = ActiveSheet'ActiveSheet.Name = "test"Set fd = Application.FileDialog(msoFileDialogFilePicker)With fd' .AllowMultiSelect = TrueIf .Show = -1 ThenFor Each file In .SelectedItemsb = Split(Replace(file, ".txt", ""), "\")'Workbooks.OpenText Filename:=file, Origin:=936, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True, Other:=FalseWorkbooks.OpenText Filename:=file, Origin:=936, DataType:=xlFixedWidth, Other:=FalseActiveSheet.UsedRange.Copy newSh.[a1]newSh.UsedRange.Font.Size = 10'newSh.Name = b(UBound(b))  '导入文件名ActiveWorkbook.Close FalseNextElseApplication.DisplayAlerts = False     '避免删除警告newSh.DeleteSet newSh = NothingApplication.DisplayAlerts = True      '重新打开End IfEnd 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).ValueqCol(k).iCKShort = tmpSh.Cells(i, eCol - 1).Value '总持 空Else'   mainsh.Cells(mRow + 11, mcol + k - 1).Value = tmpsh.Cells(i, 5).ValueqCol(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 SubLine Input #1, textlineiPinzhong = 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, textlineDim b() As Byteb = 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 + 1Loop

调用子函数 (截取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 ByteReDim buf(iLen - 1) As Byte' 这里byt(0)和byt(iStart)传进去的是地址CopyMemory buf(0), byt(iStart), iLenSubArray = bufEnd Function

因为VB（或者VB）对字符的处理为Unicode，中文与数字的长度都是1，而实际上文本里对齐是因为中文占了2个位置而数字英文都只占了1个位置。故先使用StrConv （见以前文章）转化为字节数组，再取其长度。