Excel VBA 债券交易审批单打印模板粉丝需求响应

本文首发于2023年7月27日我的同名公众号：学习和使用Excel，更多文章案例搜索关注！

执行摘要

根据证券交易详情生成审批表

用户表单

单元格文本颜色设置

大家好，我正在用冷水泡茶。前两天，可能有粉丝朋友看了我的文章【批量复制单元格区域并连续生成打印模板】并向我公司微信发送了请求：

我看了一下，他的需求如下：

1、有一个明细表，记录详细的证券交易记录，有多个字段：

2、有打印审批表的模板：

3、经沟通确定具体需求如下：

经过分析，基本可以满足你的需求。我花了一段时间才做到这一点。让我们来看看：

解决方案

1在正文中定义一些关键词，标题类型，买卖方向，价值，余额等。定义相应的变量和控件以进行提取和保存。

2可以根据关键词过滤详细的标题信息。

3如果详细的证券交易数据超过当前预定义的行数，则必须输入。如果空白行超过预定义的行数，则必须将其删除。

4、打印格式可在EXCEL中设定，无需编码即可完成。

5设置用户表单并放置所需的关键字段以供选择。

实施过程

1创建一个用户窗体：UserForm1并在其上放置必要的控件，如下所示：

2、编写代码：

(1)定义公共变量

可能有些变量没有被使用。现在先忽略这一点，让我们先看一下代码。

(2)表单初始化代码：

PrivateSubUserFormInitialize()DimwsAsWorksheetDimDicDateAsObjectDimlastRowAsInteger,lastColAsIntegerSetwsThisWorkbookSheets('详细信息')SetDicDateCreateObject('ScriptingDictionary')wsActivatelastRowwsUsedRangeRowsCountlastColwsUsedRangeColumnsCountarrDetailwsRange（单元格（3,1），单元格（最后一行，lastCol))ValueiRowUBound(arrDetail,1)iColUBound(arrDetail,2)DatePospxy('签名日期',arrDetail,'Col',1)TypePospxy('债券类型',arrDetail,'Col',1)DirectionPospxy('购买和卖出方向',arrDetail,'Col',1)BalancePospxy('Balance',arrDetail,'Col',1)AmountPospxy('Amount',arrDetail,'Col',1)'StopFori2ToiRowIfarrDetail(i,DatePos)''thenDicDate(CDate(arrDetail(i,DatePos)))1EndIfNextWithMeCmbDateListDicDatekeysTextList(ListCount-1)EndWithEndSub

代码分析：

(a)读取矩阵表中的详细数据。

(b)给几个关键字段位置变量赋值，这样即使明细表字段顺序发生变化，也不会影响对数的访问，不需要修改代码。

(c)从字典中获取日期的唯一值并将它们分配给组合框列表。

(3)日期组合框CmbDateChange代码：

PrivateSubCmbDateChange()DimdKeyAsStringDimDicTypeAsObjectSetDicTransactionCreateObject('ScriptingDictionary')SetDicTypeCreateObject('ScriptingDictionary')AllBonds0BankBonds0IfMeCmbDate''ThenExitSubFori2ToiRowIfCDate(arrDetail(i,DatePos))

代码分析：

（一）如日期发生变化，相应的债券总余额和公共财政债券余额需重新计算。

(b)随着日期的变化，相应的证券类型也会发生变化。

(c)通过字典，获取分配给CmbBondType组合框的债券类型列表。

(d)计算政府财政债务的比例。

(4)数据查询和格式化代码：

PrivateSubDataQuery()Dimarrtrans()DimarrTem()DimTxA1AsStringDimTxB2AsStringDimTxBxAsStringDimrefRowAsIntegerDimcurrBalanceAsDoubleDimcurrAmountAsDoubleDimwsAsWorksheetSetwsThisWorkbookSheets('Template')wsActivateTxA1MeCmbBondType'业务审批表('MeDirection')'Fori1ToiRowIfwsCells(i,2)Value'2仓位状态'。thenrefRowi-1ExitForEndIfNextwsRange(Cells(5,2),Cells(refRow-1,9))ClearContentsIfrefRow>8ThenForirefRow-1To8Step-1wsRows(i)DeleterefRowrefRow-1NextEndIfk5Fori2ToiRowIfCDate(arrDetail(i,DatePos))CDate(MeCmbDate)ThenIfBondType(arrDetail(i,TypePos))MeCmbBondTypeThenIfarrDetail(i,DirectionPos)MeCmbTradeDirectionThenForj2To9wsCells(k,j)arrDetail(i,pxy(wsCells(4,j),arrDetail,'Col'计划二级Mercado'MeCmbTradeDirectionMeCmbBondTypecurrAmount'万元'TxBx'截至目前，持有债券余额为'AllBonds'万元，其中：政策性银行债余额'BankBonds'万元代表持有的总头衔的“BankBondsRate”。'WithwsRange('A1')TxA1Range('A1')FontColorvbBlackRange('A1')Characters(1,3)FontColorvbRedRange('A1')Characters(InStr(TxA1,'(')1,2)FontColorvbRedRange('b2')TxB2Range('b2')Characters(InStr(TxB2,MeCmbBondType),3)FontColorvbRedRange('b2')Characters(InStr(TxB2,MeCmbBondType)3,Len(CStr(currAmount)))FontColorRGB(0,238,238)Cells(refRow2,2)TxBxCells(refRow2,2)Characters(InStr(TxBx,'持仓债券余额')6,Len(CStr(AllBonds)))FontColorRGB(0,238,238)Cells(refRow2,2)Characters(InStr(TxBx,'政策性银行债券余额')7,Len(CStr(银行债券)))FontColorRGB(0,238,238)Cells(refRow2,2)Characters(InStr(TxBx,'债券总额')5,Len(CStr(BankBondsRate)))FontColorRGB(0238238)Cells(refRow6,2)Format(MeCmbDate,'YYYYYYYYMMMonthDDDay')EndWithEndSub

代码分析：

(a)根据要求组合成多个字符串。

(b)根据字段'2的单元格位置计算refRow参考线。如果rerRow大于8，则说明上次打印的行数超过预设数，请恢复。

(c)根据关键字过滤数据并写入“模型”。如果详细数据的行数超过预定义的行数，则将相应地插入行。

(d)将生成的字符串写入相应的单元格并为关键字着色。对此没有明确的要求，但是我看到模板中颜色是这样标记的，所以我这样做了。

(5)债券类型CmbBondTypeChange代码

PrivatesubcmbbNdtypechange()DIMDICDIRECTIONASOBjectifmecmbbondtype'ThenexitSubsetCreateObject('scriptingDictionary')ToirowifcDate(Mcmbdate)CDATE(ARRDETAIL(I,DatePos))TheNifbondType(Arrdetail(I,Typepos))mecmbbondtypethendicTion(Irdetail(i,Dire,Dire))CTIONPOS))1EndIfEndIfNextWithMeCmbTradeDirectionClearListDicDirectionkeysTextList(ListCount-1)EndWithEndSub

代码分析：

(a)如果债券类型发生变化，对应的买卖方向也会发生变化，需要重新获取数量以精确匹配。

(6)其他代码，包括两个自定义函数：

PrivateSubCmdExistClick()UnloadMeEndSubPrivateSubCmdDataQueryClick()CallDataQueryUnloadMeEndSubPrivateSubCmdPrintClick()DimwsAsWorksheetCallDataQueryIfApplicationDialogs(xlDialogPrinterSetup)ShowFalseThenExitSubEndIfSetwsThisWorkbookSheets('template')wsPrintOutCopies:1SetwsNothingEndSubFunctionpxy(tx,arrAsVariant,OptionaldirectionAsString'Col',OptionallineAsInteger1)OnErrorResumeNextiRowUBound(arr,1)iColUBound(arr,2)Ifdirection'Col'ThenForiLBound(arr,2)ToiColIfarr(line,i)txThenpxyiExitFunctionEndIfNextElseForiLBound(arr,1)ToiRowIfarr(i,line)txThenpxyiExitFunctionEndIfNextEndIfpxy0EndFunctionFunctionBondType(sType)DimcTypeAsStringcType'类型'/'If我nStr('/国开债券/进出口债券/农发债券/',cType)>0ThenBondType'政金融债'ElseBondType'其他债券'EndIfEndFunction

总结

1问题初步解决，但可能不完全满足需求，或者还存在Bug，以后可能会修改。

2如果您有什么特殊需求或者发现任何Bug，请在评论中留言。谢谢！

喜欢的话就点个赞，点击观看并留言吧！