发票小助手重磅更新

发票标志重复记录

发票删除重复记录

发票文件归档

大家好，我是冷水泡茶，前几天我们分享了2篇电子发票信息读取的文章（ExcelVBA应用案例分享/电子发票管理小助手/电子发票信息读取）以及（ExcelVBA应用案例分享/电子发票管理助手/电子发票信息读取/更新、补充、使用说明），我的本意是分享EXCEL读取PDF、XML方法与思路，但后来发现感兴趣的人很多，我感觉心里有点不踏实了，我估计有很多人是要拿去实际应用了。

思来想去，还是决定再进一步完善，让在工作中使用它的朋友能更方便，数据更准确一些。

一、发票信息读取

首先，我们要增加PDF文件读取的准确性，由于是通过AcrobatPro转成Word再进行文本提取，对于不同版式的发票，我们取得的待提取文件差异较大，所以必须多找一些发票来测试。

于是我用它来读取公司的一些发票，300张发票，搞了大概1~2个小时，具体记不清了，反正速度不太理想，当然，日常使用也不会一次读取这么多的发票。

读取结果还是不错的，大多都能正确读取（以信息读取完全为标准，实际准确性待验证）。

最近一段时间，把读取不完整的发票再分别情况更新代码：

1、PDF格式：检查wordcontent，然后更新正则表达式。有些发票它转成WORD全是乱码，或者干脆转换不了，这样的发票就没有办法了，除非以后调整PDF文件的读取方式，目前这种方法真的只能两手一摊

2、OFD格式：调整取数方式与逻辑

（1）对于旧版“XX增值税电子普通发票”，原来是从解压出来的Attachs文件夹下的original_文件中提取数据，但由于新的电子发票没有这个Attachs文件夹，所以统一从Doc_0\Pages\Page_0\中取数。

（2）主节点的ID各有不同，其下items的节点ID也不尽相同，需要分别处理。

layerID=("/ofd:Page/ofd:Content/ofd:Layer/@ID").Text

（A）电子发票（普通发票），ID=6955或6947

（B）电子发票（普通发票）_货物运输服务，ID=6989

（C）XX增值税电子普通发票，ID=60

（D）其他格式的发票没有样本，未知，碰到再说。

（3）对于金额、税额、价税合计，由于同样的版式它的节点ID都有不一样的，比较难搞，最后分析节点发现在每个合计金额前都有一个“￥”，然后通过循环节点的方式定位“￥”符号，取其下一个节点的金额。这里还有个小陷阱，就是这个“￥”，直接输入这个符号却不能定位到XML中的“￥”符号，得用编码ChrW(165)来表示“￥”，方才识别成功。

这里取得数据后，存到数组，考虑到免税等异情况下，税额可能不是数字，所以把取得的节点text转换成Double类型，然后排序，取最大值为价税合计，第二大值为金额，两者相减为税额。

（4）对于开票项目，查找包含2个“*”的节点，如果有多个明细项目，则会全部取出，以“\”号隔开。这里还要考虑密码区有“*”的情况，给开票项目限定了一个长度。

二、调整代码结构，把共同的代码块改为独立的过程，再调用。

三、增加功能：

1、结果表Result增加表头字段：

（1）归档文件：把发票文件以发票代码+“_”+发票号码的形式命名保存在归档文件夹下。

（2）电子票号：发票代码+“_”+发票号码，便于查重

（3）登记日期：增加登记日期字段，便于管理，也可以考虑增加报销日期或记账日期，跟财务月份相对应。

2、发票查重：把所有重复的发票标上颜色，第一条灰色，第二条绿色，第三条蓝色

SubHighlightDuplicateRecords()'重复值标色DimwsAsWorksheetDimlastRowAsLong,lastColumnAsLongDimcolorIndexAsIntegerDimarr(),tbTitle()=("Result")'lastRow=(,"D").(xlUp).===(Cells(1,1),Cells(lastRow,lastColumn)).(Cells(2,1),Cells(lastRow,lastColumn)).=vbWhiteFori=1TolastColumnReDimPreservetbTitle(k)tbTitle(k)=arr(1,i)k=k+1Next'标记重复记录DimpickedRowsAsStringFori=2TolastRowIfInStr(pickedRows,"\"i"\")=0ThencolorIndex=1key1=arr(i,Pxy(tbTitle,"电子票号"))Forj=i+1TolastRowkey2=arr(j,Pxy(tbTitle,"电子票号"))Ifkey2=(Cells(i,1),Cells(i,lastColumn)).=PickColor(0)(Cells(j,1),Cells(j,lastColumn)).=PickColor(colorIndex)pickedRows=pickedRows"\"j"\"colorIndex=colorIndex+1IfNextIfNext'MsgBox"查重结束！所有【发票代码+发号码】重复的已标色，无重复的为白色！"Sub

代码解析：

（1）把“Result”表内容读入数组arr()，再把表头读入数组tbTitle()，用于定位表头字段。我还是习惯用数组来处理数据。

（2）通过双层循环，比较电子票号，把重复值标色并把第二个起的重复值记到pickedRows字段里，在下次循环的时候跳过它。每找到一个重复记录，颜色代码colorIndex+1，这样每条重复的记录都给标上不同的颜色。这里自定义一个根据数字变化取不同颜色的函数：PickColor(index)

（3）最后一条代码是MsgBox，作为查重结束以后的提示，但由于我们在读取一张发票结束后会调用查重过程，MsgBox就不适合了，特别是批量读取的时候。可以给它一个参数，TRUEorFalse来决定是否显示MsgBox，但觉得没有太大意义，就算了，直接注释掉拉倒。

3、发票删除重复记录：把“Result”表中重复的记录删除，只留一条最早登记的记录，本来想搞一个选择保留最新、最旧记录的，由于时间关系，没有弄，实际上应该是保留最旧的记录，后来的记录都是重复的。

SubDeleteDuplicateRecords()'删除重复DimwsAsWorksheet,destSheetAsWorksheetDimlastRowAsLong,lastColumnAsLongDimcolorIndexAsIntegerDimarr(),tbTitle()DimdestRowAsIntegerIfNotwContinue("即将删除重复记录，此操作不可恢复，请确认！")=("Result")===(Cells(1,1),Cells(lastRow,lastColumn)).(Cells(2,1),Cells(lastRow,lastColumn)).=vbWhiteFori=1TolastColumnReDimPreservetbTitle(k)tbTitle(k)=arr(1,i)k=k+1Next'标记重复记录DimpickedRowsAsStringFori=2TolastRowIfInStr(pickedRows,"\"i"\")=0Thenkey1=arr(i,Pxy(tbTitle,"电子票号"))Forj=i+1TolastRowkey2=arr(j,Pxy(tbTitle,"电子票号"))Ifkey2=key1ThenpickedRows=pickedRows"\"j"\"IfNextIfNext'创建"Duplicate"工作表OnErrorResumeNextSetdestSheet=("Duplicate")OnErrorGoTo0IfdestSheetIsNothingThen'创建新的工作表Setsht=="Duplicate"SetdestSheet=shtIfdestRow==lastRowTo2Step-1k=InStr(pickedRows,"\"i"\")IfInStr(pickedRows,"\"i"\")0(i).CopyDestination:=(destRow,1)destRow=destRow+1'(i).DeleteIfNextCallDeleteEmptyRows(destSheet)

代码解析：

（1）在查重代码的基础上，取得重复记录所在行号，pickedRows，它是以“\”把每个行号隔开。

（2）检查有没有表“Duplicate”，没有就创建。

（3）从下往上循环，把行号在pickedRows中的记录先复制到“Duplicate”表中，以防万一删除错了可以找回来。

（4）删除重复值。

（5）调用DeleteEmptyRows过程删除空白行。

4、发票文件归档，我们读取发票的文件夹可以是任意文件夹，并且它们的发票文件名是各种各样的，我们要把它统一以发票代码+发票号码的形式重命名并保存到我们指定的文件夹下（Sheets(“Main“),D13单元格。

IfNotIsFileExists(destInvoiceFile)ThenFileCopycurrInvoiceFile,destInvoiceFileIf

代码很简单，destInvoiceFile是按我们的命名规则定义的新的发票文件名。先检查存不存在此发票文件，如果不存在，则把当前读取的发票文件复制为destInvoiceFile。

另外，如果是新电子发票20位发票号码的，我们也处理成12位代码加上“_“再加上8位号码。

有些财政电子票据，它的代码8位、号码10位，与税务发票不一致，我们这样处理：把代码后面补2个0,再加上号码前2位，号码取后8位。

5、在归档文件单元格，写入发票文件名（destInvoiceFile），并加上超级链接。如果我们更改了发票存放路径，我们会把发票文件移动到新的文件夹下，并更新超级链接。

PrivateSubCmdFolder_Click()DimfolderAsStringDimoldfolderAsStringoldfolder=Sheets("Main").Range("D13")folder=FolderSelectedIffolder""ThenRange("D13")=folderElseMsgBox"未选择文件夹!"ExitSubIfCallMoveFilesInFolder(oldfolder,folder)CallupdateHyperlinksSubSubupdateHyperlinks()DimwsAsWorksheetDimiColAsIntegerDimlastRowAsInteger,lastColAsIntegerDimfolderAsStringDiminvoiceFileAsStringDimrngAsRangeDimnewFileAsStringfolder=Sheets("Main").Range("D13").ValueSetws=Sheets("Result")lastRow===1TolastColIfCells(1,i)="归档文件"TheniCol=iExitForIfNextWithwsFori=2TolastRowSetrng=.Cells(i,iCol)Ifrng""TheninvoiceFile=Right(rng,Len(rng)-InStrRev(rng,"\"))newFile=folder"\":=rng,_Address:=newFile,_TextToDisplay:=newFileIfNextWithSubSubMoveFilesInFolder(ByValSourceFolderAsString,ByValDestinationFolderAsString)DimFileSystemAsObjectDimSourceFileAsObjectDimdestFileAsString'确保源文件夹和目标文件夹存在IfDir(SourceFolder,vbDirectory)=""ThenMsgBox"源文件夹不存在！",vbExclamationExitSubIfIfDir(DestinationFolder,vbDirectory)=""ThenMsgBox"目标文件夹不存在！",vbExclamationExitSubIf'创建文件系统对象SetFileSystem=CreateObject("")'获取源文件夹下的所有文件(SourceFolder).FilesdestFile=DestinationFolder"\"(destFile)Then'移动文件,destFileIfNextSub

代码解析：移动文件、更新链接都做成了单独的过程。

6、在workbook_open事件中，添加检查发票文件夹的代码，如果文件夹不存在则给出提示。

PrivateSubWorkbook_Open()IfNotIsFolderExists(Sheets("Main").Range("D13"))ThenMsgBox"请选择发票文件归档文件夹！"IfSub

这次更新的改动比较大，功能也更全面了，如果作为一个小企业的财务，发票都是到财务这里统一登记的，那么今天的电子发票登记管理系统（EXCEL版）将会极大的解放你的生产力。

好，今天就这样吧。欢迎点赞、留言、分享，谢谢大家，我们下期再会。

☆猜你喜欢☆

ExcelVBA电子发票管理助手

ExcelVBA凭证打印

ExcelVBA中医诊所收费系统

ExcelVBA动态添加控件

ExcelVBA酷炫的日期控件

Excel固定资产折旧计提表

ExcelVBA数组字段定位排序

Excel处理重复值

ExcelVBA最简单的收发存登记系统

Excel公式函数/查找函数之LOOKUP

ExcelVBA文件批量改名

Excel公式函数/动态下拉列表

ExcelVBA输入逐步提示

Excel基础功能【数据验证】