|
楼主 |
发表于 2014-5-29 12:18
|
显示全部楼层
本帖最后由 燠风 于 2014-5-29 15:18 编辑
-
社保明细审核表.rar
(16.91 KB, 下载次数: 18)
Sub 社保1()
- Dim FileName As String
- Dim r As Integer
- FileName = Dir(ThisWorkbook.Path & "\*.xls")
- Do While FileName <> ""
- If FileName <> ThisWorkbook.Name Then k = ThisWorkbook.Path
- Workbooks.Open k & "" & FileName
- r = Left(FileName, 2)
- Range("L4").Select
- ActiveCell.FormulaR1C1 = "1"
- Range("L4").Select
- Selection.Copy
- Range("E9:BJ452").Select
- Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
- SkipBlanks:=False, Transpose:=False
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本养老保险(非本市城镇户籍)" Then If Cells(8, i + 1) = "单位" Then Cells(3, 79) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
-
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本养老保险(非本市城镇户籍)" Then If Cells(8, i + 2) = "个人" Then Cells(3, 80) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 2), Cells(300, i + 2)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本养老保险" Then If Cells(8, i + 1) = "单位" Then Cells(4, 79) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本养老保险" Then If Cells(8, i + 2) = "个人" Then Cells(4, 80) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 2), Cells(300, i + 2)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本医疗保险" Then If Cells(8, i + 1) = "单位" Then Cells(3, 81) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "基本医疗保险" Then If Cells(8, i + 2) = "个人" Then Cells(3, 82) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 2), Cells(300, i + 2)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "工伤保险" Then If Cells(8, i + 1) = "单位" Then Cells(3, 85) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "生育保险" Then If Cells(8, i + 1) = "单位" Then Cells(3, 86) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "重大疾病医疗补助" Then If Cells(8, i + 1) = "单位" Then Cells(3, 87) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "失业保险" Then If Cells(8, i + 1) = "单位" Then Cells(3, 83) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
-
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "失业保险" Then If Cells(8, i + 2) = "个人" Then Cells(3, 84) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 2), Cells(300, i + 2)))
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "城镇职工补充医疗保险" Then If Cells(8, i + 1) = "单位" Then Cells(3, 88) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
-
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "过渡性基本医疗保险金" Then If Cells(8, i + 1) = "单位" Then Cells(4, 88) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
-
- Next i
- For i = 4 To 30 Step 1
- If Cells(7, i) = "失业保险(农民工)" Then If Cells(8, i + 1) = "单位" Then Cells(4, 83) = Application.WorksheetFunction.Sum(Range(Cells(9, i + 1), Cells(300, i + 1)))
-
- Next i
- Windows("" & r & ".XLS").Activate
- Range("CA3:CJ3").Select
- Selection.Copy
- Windows("社保明细审核表.xls").Activate
- Range("B" & r + 8).Select
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- Windows("" & r & ".XLS").Activate
- Range("CA4:CJ4").Select
- Application.CutCopyMode = False
- Selection.Copy
- Windows("社保明细审核表.xls").Activate
- Range("B" & r + 8).Select
- Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
- :=False, Transpose:=False
- End If
- FileName = Dir ' 用Dir 函数取得其他文件名,并赋给变量
- Loop
- Workbooks.Close
- End Sub
复制代码 楼上的当文件少了1个就会出现下标越界,比楼上好在,如果不是12个文件也可以运行,可以不用改文件路径名了,放在其他地方也可以用,但是该文件夹要只有这些文件,如果有其他不相干的文件就会出错 |
|