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