ExcelVBA一健整理（机关事业） 单位保险费征收台账总表

ExcelVBA一健整理（机关事业）单位保险费征收台账总表

【解决的问题】

每个月在社保系统上下载的表格，我们要做两件事：

1.删除重复出现的“标题行” 2.把其中的某些行列的数据文本格式转化为数值格式（身份证与个人编号不要转）

我们每个月在社保系统下载的“（机关事业） 单位保险费征收台账总表”中总要整理一下，因为每22个人就有一个下面的标题出现

1-6行

29-33行

我们要整理的是：把1-6行的标题保留下来，后面行出现的标题的行要删除掉

呢？

1

常规的做法有两种

【常规解决方法一】手工几行几行的删除，最原始的方法

【常规解决方法二】利用筛选方法，再删除，比方法一快一点

以上的两种方法还是比较慢，如果有大量的数据就。。。。晕了

2

VBA解决方法

【VBA解决方法】

思路：用Find 找到"费款所属期", "职业年金", "其中", "本月应征", "个人"所在的行，把整个行删除就可以啦

代码如下：

Sub 整理社保台账()

Dim Sh As Worksheet, i As Integer

Application.ScreenUpdating = False

arr = Array("费款所属期", "职业年金", "其中", "本月应征", "个人")

With ActiveSheet

Set Rng = .Rows("56565")

For i = 0 To UBound(arr)

Set c = .Cells.Find(arr(i), LookIn:=xlValues)

If Not c Is Nothing Then

firstAddress = c.Address

Do

If c.Row > 7 Then

Set Rng = Union(Rng,Rows(c.Row))

End If

Set c = .Cells.FindNext(c)

Loop While Not c Is Nothing Andc.Address <> firstAddress

End If

Next

Rng.Delete

End With

MsgBox "完成"

Application.ScreenUpdating = True

End Sub

【优化一下代码】

Sub 删除n行优化版本()

Dim Sh As Worksheet, i As Integer

Application.ScreenUpdating = False

ti = Timer()

arr = "费款所属期"

x_row = 4

With ActiveSheet

Set rng = .Rows("56565")

Set c = .Cells.Find(arr, LookIn:=xlValues)

If Not c Is Nothing Then

firstAddress = c.Address

i = 1

Do

If c.Row > 7 Then

Set rng = Union(rng,.Rows(c.Row & ":" & c.Row + x_row))

End If

Set c = .Cells.FindNext(c)

i = i + 1

Loop While Not c Is Nothing And c.Address <> firstAddress

End If

rng.Select

rng.Cells.Interior.ColorIndex = 3

' rng.Delete

End With

MsgBox "整理完成" & Chr(10) &"找到" & i & "个" & Chr(10) & "时间为："& Format(Timer - ti, "00.00秒")

Application.ScreenUpdating = True

End Sub

3

把数据文本格式转化为数值格式

代码

Sub TextToNumber()

Dim A As Range

On Error Resume Next

Set A = Application.InputBox(Prompt:="选择数据",Title:="提示", Type:=8)

On Error GoTo 0

If A Is Nothing Then

Exit Sub

Else:

' MsgBox A.Address

With A

.NumberFormatLocal = ""

.Value = .Value

End With

End If

End Sub

-------最终代码如下------