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
-------最终代码如下------
