学步园

    现要求:给出一个空汇总表,给出若干单独的Excel文件,每个文件里头有一个表格里存有一个人的信息,要将这些文件里的信息全部对应地导入到汇总表里.

    以前写的,也不给实际例子了,直接上代码,逻辑不复杂,看看就明白.记在这里备以后查.

Sub ExportMyFile()<br /> Dim myPath, myFileName<br /> Dim myCurOpenWB As Workbook 'work工作簿<br /> Dim myCurOpenWS As Worksheet 'work工作表<br /> Dim myTotalWS As Worksheet '汇总工作表</p> <p> Dim myFolderName As String<br /> myFolderName = "六堰"</p> <p> Set myTotalWS = ThisWorkbook.Sheets("附件4") '汇总到表名为附件4的表格里</p> <p> myPath = ThisWorkbook.Path & "/" & myFolderName & "/*.xls"<br /> myFileName = Dir(myPath) '''''''''''''''''''''''''''''''''''<br /> 'Dim iCounter As Integer<br /> 'iCounter = 0</p> <p> '遍历指定目录下的文件并操作<br /> Do '''''''''''''''''''''''''''''''''''''<br /> Debug.Print myFileName</p> <p> Dim searchStr As String '通用搜索字符串<br /> Dim resStr As String '通用结果字符串<br /> Dim iCount As Integer '通用计数器</p> <p> myFileName = ThisWorkbook.Path & "/" & myFolderName & "/" & myFileName</p> <p> '打开指定目录里的一个*.xls文件<br /> 'Debug.Print myFileName<br /> Set myCurOpenWB = Workbooks.Open(myFileName)<br /> Set myCurOpenWS = myCurOpenWB.Sheets("附件1") '打开文件的sheet附件1里是分条数据</p> <p> '插入内容行<br /> Dim iC As Integer<br /> For iC = 0 To 3<br /> '插入内容行<br /> myTotalWS.Rows(6).Insert<br /> myTotalWS.Rows(6).RowHeight = 14.25<br /> myTotalWS.Range("B6:Q6").NumberFormat = "@" '将它们的数字格式设置成文本<br /> Next</p> <p> '##################################复制数据过程######################################<br /> '序号 =Row()-5<br /> myTotalWS.Range("A6").Formula = "=INT(Row()/4)"</p> <p> '姓名 C4<br /> myTotalWS.Range("B6").Value = myCurOpenWS.Range("C4").Value</p> <p> '性别 F4<br /> myTotalWS.Range("C6").Value = myCurOpenWS.Range("F4").Value</p> <p> '出生年月 C6<br /> myTotalWS.Range("D6").Value = myCurOpenWS.Range("C6").Value</p> <p> '身份证 D8<br /> myTotalWS.Range("E6").Value = myCurOpenWS.Range("D8").Value</p> <p> '进厂劳动时间 B21-B25<br /> myTotalWS.Range("F6").Value = myCurOpenWS.Range("B21").Value<br /> myTotalWS.Range("F7").Value = myCurOpenWS.Range("B22").Value<br /> myTotalWS.Range("F8").Value = myCurOpenWS.Range("B23").Value<br /> myTotalWS.Range("F9").Value = myCurOpenWS.Range("B24").Value</p> <p> '离岗时间 B21-B25</p> <p> '劳动年限 I26<br /> myTotalWS.Range("H6").Value = myCurOpenWS.Range("I26").Value</p> <p> '原用工单位 D21-D25<br /> 'myTotalWS.Range("I6").Value = myFolderName<br /> myTotalWS.Range("I6").Value = myCurOpenWS.Range("D21").Value<br /> myTotalWS.Range("I7").Value = myCurOpenWS.Range("D22").Value<br /> myTotalWS.Range("I8").Value = myCurOpenWS.Range("D23").Value<br /> myTotalWS.Range("I9").Value = myCurOpenWS.Range("D24").Value</p> <p> '用工类别 D26<br /> myTotalWS.Range("J6").Value = "家属工"</p> <p> '已享受保障 B28-B30<br /> searchStr = myCurOpenWS.Range("B28").Value<br /> resStr = ""<br /> iCount = 0<br /> If InStr(searchStr, "√") <> 0 Then<br /> resStr = resStr & "城市最低生活保障"<br /> iCount = iCount + 1<br /> End If<br /> searchStr = myCurOpenWS.Range("B29").Value<br /> If InStr(searchStr, "√") <> 0 Then<br /> If iCount <> 0 Then<br /> resStr = resStr & "、"<br /> End If<br /> resStr = resStr & "遗属生活困难补助"<br /> iCount = iCount + 1<br /> End If<br /> searchStr = myCurOpenWS.Range("B30").Value<br /> If InStr(searchStr, "√") <> 0 Then<br /> If iCount <> 0 Then<br /> resStr = resStr & "、"<br /> End If<br /> resStr = resStr & "供养亲属抚恤费"<br /> End If<br /> myTotalWS.Range("K6").Value = resStr</p> <p> '已参加社保 B32-B34<br /> searchStr = myCurOpenWS.Range("B32").Value<br /> resStr = ""<br /> iCount = 0<br /> If InStr(searchStr, "√") <> 0 Then<br /> resStr = resStr & "企业职工养老保险"<br /> iCount = iCount + 1<br /> End If<br /> searchStr = myCurOpenWS.Range("B33").Value<br /> If InStr(searchStr, "√") <> 0 Then<br /> If iCount <> 0 Then<br /> resStr = resStr & "、"<br /> End If<br /> resStr = resStr & "灵活就业人员养老保险"<br /> iCount = iCount + 1<br /> End If<br /> searchStr = myCurOpenWS.Range("B34").Value<br /> If InStr(searchStr, "√") <> 0 Then<br /> If iCount <> 0 Then<br /> resStr = resStr & "、"<br /> End If<br /> resStr = resStr & "城镇居民医疗保险"<br /> End If<br /> myTotalWS.Range("L6").Value = resStr</p> <p> '配偶姓名 C10<br /> myTotalWS.Range("M6").Value = myCurOpenWS.Range("C10").Value</p> <p> '配偶现所在单位<br /> myTotalWS.Range("N6").Value = "重型车厂"</p> <p> '配偶人员类别 C12<br /> 'myTotalWS.Range("O6").Value = myCurOpenWS.Range("C12").Value<br /> searchStr = myCurOpenWS.Range("C12").Value<br /> If InStr(searchStr, "√去世") <> 0 Then<br /> myTotalWS.Range("O6").Value = "去世"<br /> ElseIf InStr(searchStr, "√离休") <> 0 Then<br /> myTotalWS.Range("O6").Value = "离休"<br /> ElseIf InStr(searchStr, "√退休") <> 0 Then<br /> myTotalWS.Range("O6").Value = "退休"<br /> ElseIf InStr(searchStr, "√退养") <> 0 Then<br /> myTotalWS.Range("O6").Value = "退养"<br /> Else<br /> myTotalWS.Range("O6").Value = "在职"<br /> End If</p> <p> '备注<br /> myTotalWS.Range("P6").Value = myFolderName</p> <p> '联系电话<br /> myTotalWS.Range("Q6").Value = myCurOpenWS.Range("H18").Value</p> <p> '################################复制数据过程结束#############################</p> <p> '关闭打开的文件<br /> myCurOpenWB.Close</p> <p> myFileName = Dir ''''''''''''''''''''''''''''''<br /> ' iCounter = iCounter + 1<br /> Loop Until myFileName = "" '''''''''''''''''''''''''''''</p> <p>End Sub<br />