用VBA快速处理涉农资金管理平台，本文主要内容关键词为：管理平台论文,涉农论文,资金论文,快速论文,VBA论文，此文献不代表本站观点，内容供学术参考，文章仅供参考阅读下载。
最近笔者在参加某乡镇经济责任审计的涉农资金的审计过程中，通过核对县级涉农资金管理平台与乡镇涉农资金发放平台的相关数据，发现涉农资金管理平台中某乡镇农户信息表中地址一项错误较多。从管理平台中采集出的到村民组（队）的全部信息共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
N=2
Do While Cells（N，1）.Value＜＞""
If ActiveCell="已合并的村A" Or ActiveCell="已合并的村B"Or ActiveCell="已合并的村C"Or ActiveCell="已合并的村D"Or ActiveCell="村"Then
ActiveCell.Value=”
End If
ActiveCell.Offset（1，0）.Activate
N=N+1
Loop Range（"A1"）.Select
N=1
Do While Cells（N，1）.Value＜＞""N=N+1
Loop
区域="A1:K" & N-1
Range（区域）.Sort Key1:=Range（"A2"），Order1:=xlAscending，Key2:=_Range（"J2"），Order2:=xlDescending，Header:=xlGuess，OrderCustom:=1，_ MatchCase:=False，Orientation:=xlTopToBottom，SortMethod:=xlPinYin，_DataOption1:=xlSortNormal，DataOption2:=xlSortNormal Range（"J2"）.Select
N=2
Do While Cells（N，1）.Value＜＞'''
If ActiveCell.Value='''' Then
If Left（Cells（N，1）.Value，10）=Left（Cells（N-1，1）.Value，10）Then
ActiveCell.Value=ActiveCell.Offset（-1，0）.Value
Else
End If
End If
ActiveCell.Offset（1，0）.Activate N=N+1
Loop
End Sub
Sub M3_填充队组名称0Range（"A1"）.Select
N=1
Do While Cells（N，1）.Value＜＞'"N=N+1
Loop
区域="A1:K" & N-1
Range（区域）.Sort Key1:=Range（"A2"），Order1:=xlAscending，Key2:=_ Range（"12"），Order2:=xlDescending，Header:=xlGuess，OrderCustom:=1，_ MatchCase:=False，Orientation:=xlTopToBottom，SortMethod:=xlPinYin，_ DataOption1:=xlSortNormal，DataOption2:=xlSortNormal Range（"12"）.Select
N=2
Do While Cells（N，1）.Value＜＞''''
If ActiveCell.Value＜＞''' Then
Cells（N，11）.Value=ActiveCell.Value
Else
If Cells（N，1）.Value=Cells（N-1，1）.Value Then
Cells（N，11）.Value=Cells（N-1，11）.Value
Else
End lf
End If
ActiveCell.Offset（1，0）.Activate N=N+1
Loop
End Sub
Sub M4_规范队组名称0Range（"K2"）.Activate
N=2
Do While Cells（N，1）.Value＜＞''
If ActiveCell="卩椋冂埃" Or ActiveCell="宕遄？'Or ActiveCell=”宕遄" Or ActiveCell=”村组" _
Or Len（Trim（ActiveCell.Value）=1 Or Left（ActiveCell.不ext，1）="辶" Then
ActiveCell.Value="'
ElseIf Right（ActiveCell.Value，1）=1 Then
ActiveCell.Value=Left（ActiveCell.Value，Len（ActiveCell.Value）-1）
End If
ActiveCell.Offset（1，0）.Activate N=N+1
Loop Range（"A1"）.Select
N=1
Do While Cells（N，l）.Value＜＞''N=N+1
Loop
区域="A1:K" & N-1
Range（区域）.Sort Key1:=Range（"A2"），Order1:=xlAscending，Key2:=_
Range（"K2"），Order2:=xlDescending，Header:=xlGuess，OrderCustom:=1，_
MatchCase:=False，Orientation:=xlTopToBottom，SortMethod:=xlPinYin，_
DataOption1:=xlSortNormal，DataOption2:=xlSortNormal
Range（"K2"）.Select
N=2
Do While Cells（N，1）.Value＜＞'''
If ActiveCell.Value=”” Then
If Cells（N，1）.Value=Cells（N-1，1）.Value Then
ActiveCell.Value=ActiveCell.Offset（-1，0）.Value
Else
End If
End If
ActiveCell.Offset（1，0）.Activate N=N+1
Loop
End Sub
Sub M5规范地址0
Range（"L2"）.Select
N=2
Do While Cells（N，1）.Value＜＞""
If ActiveCell.Offset（0，-2）.Value＜＞""And ActiveCell.Offset（0，-1）.Value＜＞""Then
ActiveCell.Value=ActiveCell.Offset（0，-2）.Value&ActiveCell.Offset（0，-1）.Value
Else
ActiveCell.Value="空"
End If
ActiveCell.Offset（1，0）.Activate
N=N+1
Loop
（说明：以下语句会删除村级码完全相同的记录，执行前先请手动（自动）备份要操作的表，或将本段单独执行。自动备份的语句为：
Sheets（"原表"）.Copy Before:=Sheets（1）
Sheets（"原表（2）"）.Move After:=Sheets（"原表"）
ActiveSheet.Name="新表"
删除说明中的文字部分直接执行既可，表名根据实际情况而定）
Range（"A2"）.Select
N=2
Do While Cells（N，1）.Value＜＞""
If ActiveCell.Value=ActiveCell.Offset（-1，0）.Value Then
行=ActiveCell.Row&":"＆ActiveCell.Row
Rows（行）.Select
Selection.Delete Shift:=xlUp
Else
ActiveCell.Offset（1，0）.Activate
N=N+1
End If
Loop
End Sub
5.经过以上处理后得到含653个村组的记录，其中：完全符合规范要求的记录625条，还需人工根据村组代码进行补充的空白记录28条，大大提高了处理速度。上述结果可导回县级涉农管理平台候用。
以上方法并不唯一，还必须根据实际情况分析并进行相应的调整，特别是工作表中的函数公式，灵活性极大。以上方法不足之处敬请指正。
标签：vba论文;