提取不同表格数据分别放在对应表格内

王清8629

在系统中导出的考试成绩（即每天的“考生名单“表格）中有不同的班组（总共12个，根据“所在组织全路径”可以区分是哪一个班组），为了统计各班组的成绩，现需要在新建的表格“成绩阶段分析”中分别在不同的单元表中提取对应班组的成绩。


注意：
1.导出的考试成绩（即每天的“考生名单“）表格数量不定，有可能根据需要增加表格数量，希望放在该文件夹的表格都可以统计到
2.统计出来的数据在“成绩阶段分析”的B列自动生成时间（即导出的文件名称后面的数字）
3.系统导出的文件中的成绩默认是“文本类型”，需要转换为数字格式。

恳请大神指导帮助。

kwinawyeth

简单写了几段程序，可以简单达到要求。点击【导入】按钮就可以了

1. 
   
2. 
   
3. 
   
4. 
   
5. Sub InputData()
   
6.     On Error Resume Next
   
7. 
   
8.     Dim fl, fileType As String, data
   
9.    
   
10.     '弹出文件选择对话框
    
11.     ChDrive Left(ThisWorkbook.FullName, 1) '指向当前盘
    
12.     ChDir ThisWorkbook.Path '指向当前路径
    
13.     fl = Application.GetOpenFilename("文本文件,*.xls;*.xlsx", 1, "请点击需要导入的文件")
    
14.     If fl = False Then Exit Sub
    
15.    
    
16.     Dim dateStr As String, iCount As Long
    
17.    
    
18.     Application.ScreenUpdating = False
    
19.    
    
20.     dateStr = ExtractDate(fl) '提取日期
    
21.    
    
22.     '打开excel文件，获取数据
    
23.     data = GetXlsData(fl)
    
24.     iCount = UBound(data, 2)
    
25.    
    
26.    
    
27.     '保存数据
    
28.     Call InputSheet(data, dateStr) '写入表格中
    
29.    
    
30.     Application.ScreenUpdating = True
    
31.    
    
32.     Application.StatusBar = "数据已经导入，共导入数据" & iCount & "条"
    
33.    
    
34. End Sub
    
35. 
    
36. Private Function GetXlsData(fl) '从excel文件中提取文件
    
37.    
    
38.     Dim mySheet, ileName As String
    
39. 
    
40.     Workbooks.Open fl
    
41.     fileName = Split(fl, "")(UBound(Split(fl, ""))) '获得选取文件的文件类型
    
42.     Set mySheet = Workbooks(fileName).Sheets(1)
    
43.    
    
44.     '文件已经打开，提取数据
    
45.     Dim endRow As Long
    
46.     Dim i As Long, j As Integer
    
47.     Dim result(), r As Long
    
48.    
    
49.     endRow = mySheet.Cells(mySheet.Rows.Count, 2).End(xlUp).Row
    
50. 
    
51.     r = 0
    
52.     For i = 3 To endRow '循环行
    
53.         If Cells(i, 2) <> "" Then
    
54.             r = r + 1
    
55.             ReDim Preserve result(1 To 8, 1 To r)
    
56.             For j = 2 To 9 '选号列
    
57.                 result(j - 1, r) = mySheet.Cells(i, j) '注意split得到的数组是从0开始的
    
58.             Next j
    
59.         End If
    
60.     Next i
    
61. 
    
62.     Workbooks(fileName).Close SaveChanges:=False
    
63.     GetXlsData = result
    
64.    
    
65. End Function
    
66. 
    
67. Private Sub InputSheet(data, dateStr As String) '将数据写入到表格中
    
68. 
    
69.     Dim i As Long, j As Integer
    
70.     Dim sRow As Long, quan As String
    
71.    
    
72.     sRow = Cells(Rows.Count, 3).End(xlUp).Row
    
73. 
    
74.     For i = 1 To UBound(data, 2)
    
75.    
    
76.         sRow = sRow + 1
    
77.         quan = data(UBound(data), i)
    
78.         Cells(sRow, 1) = ExtractZhanDian(quan)
    
79.         Cells(sRow, 2) = dateStr
    
80.         For j = 1 To UBound(data)
    
81.             Cells(sRow, 2 + j) = data(j, i)
    
82.         Next j
    
83.     Next i
    
84. 
    
85. End Sub
    
86. 
    
87. Private Function ExtractDate(fl) As String '从文件名中提取日期
    
88. 
    
89.     Dim strArr, str As String
    
90.    
    
91.     strArr = Split(fl, ".")
    
92.     str = strArr(UBound(strArr) - 1)
    
93.    
    
94.     strArr = Split(str, "_")
    
95.     str = strArr(UBound(strArr))
    
96. 
    
97.     ExtractDate = Format(str, "0000-00-00")
    
98.    
    
99. End Function
    
100. 
     
101. Private Function ExtractZhanDian(quan As String) As String '从 所在组织全路径 中提取运维站点
     
102. 
     
103. 
     
104.     '中国南方电网有限责任公司/云南电网有限责任公司/昆明供电局/变电运行一所/500kV七甸巡维中心
     
105.     Dim strArr, str As String
     
106.    
     
107.     strArr = Split(quan, "/")
     
108.     str = strArr(UBound(strArr))
     
109.    
     
110.     strArr = Split(str, "V")
     
111.     str = strArr(UBound(strArr))
     
112.    
     
113.     str = Replace(str, "巡维中心", "") '去掉  运维中心
     
114.     str = Replace(str, "变电站", "") '去掉  变电站
     
115. 
     
116.     ExtractZhanDian = str
     
117.    
     
118. End Function
     
119. 
     
120. 
     
121. 
     

复制代码