用VBA快速处理涉农资金管理平台

作 者:

作者简介:
黄彤彪,望江县审计局

原文出处:
安徽审计

内容提要:


期刊代号:V3
分类名称:审计文摘
复印期号:2013 年 06 期

关 键 词:

字号:

      最近笔者在参加某乡镇经济责任审计的涉农资金的审计过程中,通过核对县级涉农资金管理平台与乡镇涉农资金发放平台的相关数据,发现涉农资金管理平台中某乡镇农户信息表中地址一项错误较多。从管理平台中采集出的到村民组(队)的全部信息共1213条,主要错误表现在地址中:只有乡镇名称没有村名的251条记录、使用未并村前村名的4条记录、村名为乱码的1条记录:只有乡镇与村名没有村民组(队)名称的149条记录,记录出现乱码的22条记录:地址内空还出现一些不必要半角或全角括号。这些错漏在乡镇涉农资金发放平台中,并没有实质性的影响,但从乡镇涉农资金发放平台中采集该项内容,程序非常繁琐,采集完成后并不能保证审计管理平台与发放平台的数据的正确性。有鉴如此,在实际工作中需对县级涉农管理平台中采集的数据进行相应的处理后供审计使用。本人按以下方法进行了处理:

      1.从县级涉农资金管理平台中采集农户信息,经预处理后得到某乡镇到村民组(队)的全部信息共1213条,考虑直观性将其导成电子表(*.xls)形式。

      2.表头列分别设为:A-村组码、B-地址、C-“镇(乡)”字所在位置、D-“村”字所在位置、E-“组(队)”字所在位置、F-“(“字符所在位置、G-”)”字符所在位置、H-提取的村名、I-提取的组(队)名、J-规范村名、K-规范队名、L-规范后地址。(以上F列、G列的括号为全角方式)

      3.在第2行C~J列中分别填写如下公式:

      C2单元格:IF(ISERROR(FINDB("镇",B2),IF(ISERROR(FINDB("乡",B2),"无",FINDB("乡",B2),FINDB("镇",B2));

      D2单元格:IF(ISERROR(FINDB("村",B2),"无",FINDB("村",B2));

      E2单元格:IF(ISERROR(FINDB("队",B2),IF(ISERROR(FINDB("组",B2),"无",FINDB("组",B2),FINDB("队",B2));

      F2单元格:IF(ISERROR(FINDB("(",B2)),"无",FINDB("(",B2));

      G2单元格:IF(ISERROR(FINDB(")",B2),"无",FINDB(")",B2));

      H2单元格:IF(AND(ISNUMBER(C2),ISNUMBER(D2),TRIM(MIDB(B2,C2+1,D2-C2+1)),"");

      12单元格:IF(AND(C2="无",D2="无",F2="无",G2="无"),"错",TRIM(IF(AND(ISNUMBER(D2),ISNUMBER(E2),G2="无"),TRIM(MIDB(B2,D2+1,E2-D2+1),IF(ISNUMBER(G2),MIDB(B2,G2+1,10),IF(D2="无",MIDB(B2,C2+1,10),IF(AND(ISNUMBER(D2),E2="无",F2="无",G2="无"),MIDB(B2,D2+1,10),"A"))))))。

      (以上F列、G列的括号为全角方式)。

      将上述公式向下一直复制到第1214行。得到本文前述的“错误表现”。

      4.如要手动对其进行修改,工作量大且易出错,故通过VBA编写宏的方法由电脑自动执行。具体代码如下:

      Sub M1_填充村名称0

      Range("A1").Select

      N=1

      Do While Cells(N,1).Value<>""

      N=N+1

      Loop

      区域="A1:K"&N-1

      Range(区域).Sort Key 1:=Range(“A2”),Order 1:=xlAscending,Key 2:=_

      Range("H2"),Order2:=xlDescending,

      Header:=xlGuess,OrderCustom:=1,_MatchCase:=False,Orientation:=xlTopToBottom,SortMethod:=xlPinYin,_DataOption1:=xlSortNormal,DataOption2:=xlSortNormal

      Range("H2").Select

      N=2

      Do While Cells(N,1).Value<>""

      If ActiveCell.Value<>""Then

      Cells(N,10).Value=ActiveCell.Value

      Else

      If Left(Cells(N,1).Value,10)=Left(Cells(N-1,1).Value,10)Then

      Cells(N,10).Value=Cells(N-1,10).Value

      Else

      End If

      End If

      ActiveCell.Offset(1,0).Activate

      N=N+1

      Loop

      End Sub

      Sub M2_规范村名称0

      Range("J2").Activate

相关文章: