精品word.
最新文件---------------- 仅供参考--------------------已改成-----------word文本 --------------------- 方便更改
一步一步教你用VBA自动从一个表按条件把数据填充到另一张表
高考上线与未上线统计，下面是某市2013年高考总分与单科分数线
2013年全市文科分数线
全市人数 科目 一本 人数 分数 科目 三本 人数 分数 语文 380 112 语文 4739 99 数学 426 128 数学 4754 105 一本分数 人数 三本分数 567 372 477 人数 4547 外语 444 128 外语 4691 99 政治 391 71 政治 4732 60 历史 地理 综合 476 82 394 74 393 217 历史 地理 综合 4671 4547 4575 71 57 184 单科分数线以语文为例：全市一本372人，即语文在372名的分数即为语文的上线分数。这里关键统计某人总分上了某一分数线，而单科没上分数线的人数。进一步统计上该科老师头上该科是否努力，是不是拖了后腿。
原始成绩放sheet1表中，统计后的数据放sheet2表中，科任教师名单放sheet3表中，数据如下：
1． 原始成绩表sheet1:
姓名
班级
语文
数学
外语
综合
政治 历史 地理
加分
总分
向恭谱 郑淞方 姜岚
02 02 02
114 126 138 229 67 84.5 77.5
83 73.5 82
79
0 607 0 602 0 600
114 127 132 229 72.5 110 129 131 230
69
1 / 7
精品word.
沈鑫 陈静 蒋儒 张璇琳
02 02 02 02
108 137 129 225 72.5 112 122 130 233 116 129 126 226 116 130 126 224 112 132 128 222
73 72 68
74 81
78 79
0 599 0 597 0 597 0 596 0 594 0 594 0 592 0 591 0 587 0 586 0 587 0 569 0 567 0 566
81 72.5 84 71.5
李罗一帆 02 廖梓君 何志文 李昀霞 刘奕伶 赵原巧 黄莹 雷凯迪 梁虹 邓铃
02 02 02 02 02 06 06 06 06
69 79.5 73.5
83
71 76
113 129 125 227 72.5
112 112 133 235 76.5 82.5 113 127 134 217
69
77 70.5
68
110 125 130 222 69.5 84.5 110 120 130 226
71 79.5 75.5
82 87
73
113 119 123 232 76.5 113 109 128 219 67.5 110 126 125 206
71 73.5 61.5
72
73
109 123 123 211 65.5
2.科任教师表sheet3
班 1 2 3 4 5 6 7 8 9 10 班主任 肖友老师 陈小老师 张小老师 鲜松老师 何万老师 唐建老师 刘 老师 陈 老师 邓君老师 敬文老师 语文 刘 老师 邓小老师 姚 老师 李 老师 敬文老师 唐建老师 姚仁老师 刘 老师 邓小老师 敬文老师 数学 肖友老师 向 老师 王春老师 鲜松老师 何万老师 龙泽老师 刘 老师 罗巧老师 赵元老师 鲜松老师 外语 肖雪老师 陈 老师 陈 老师 高乐老师 王文老师 高乐老师 冯 老师 赵文老师 贾 老师 王文老师 物理 张长老师 何继老师 徐文老师 冯朝老师 张长老师 魏定老师 杜 老师 冯朝老师 何继老师 徐文老师 化学 吴明老师 邓君老师 王 老师 李 老师 陈 老师 唐双老师 吴明老师 陈 老师 邓君老师 吴明老师 生物 王耀老师 陈小老师 张小老师 黄家老师 黄家老师 林玉老师 王耀老师 张小老师 林玉老师 张小老师 3.统计结果sheet2: 2 / 7
精品word.
未上线未上线分班 姓名 02 向恭谱
02 郑淞方
02 姜岚
02 沈鑫
02 陈静
02 蒋儒
02 张璇琳
02 李罗一帆
02 廖梓君
02 何志文 02 李昀霞
总分 类别 607 一本
602 一本
600 一本
599 一本
597 一本
597 一本
596 一本
594 一本
594 一本
592 一本 591 一本
科目 数
数学 政治 数学 地理 语文 政治 语文 历史 数学 历史 外语 历史 地理 外语 政治 地理 政治 历史 地理 外语 地理 数学 数学
3 / 7
科任教师
126 向 老师 67 何继老师 127 向 老师 73.5 陈小老师 110 邓小老师 69 何继老师 108 邓小老师 74 邓君老师 122 向 老师 81 邓君老师 126 陈 老师 81 邓君老师 72.5 陈小老师 126 陈 老师 68 何继老师 71.5 陈小老师 69 何继老师 79.5 邓君老师 73.5 陈小老师 125 陈 老师 71 陈小老师 112 向 老师 127 向 老师
精品word.
587 一本
政治 历史 地理 语文 数学 政治 地理 语文 数学 历史 数学 外语 地理 数学 政治 地理 语文 数学 外语 历史 地理
69 何继老师 77 邓君老师 70.5 陈小老师 110 邓小老师 125 向 老师 69.5 何继老师 68 陈小老师 110 邓小老师 120 向 老师 79.5 邓君老师 119 龙泽老师 123 高乐老师 73 林玉老师 109 龙泽老师 67.5 魏定老师 林玉老师 110 唐建老师 126 龙泽老师 125 高乐老师 73.5 唐双老师 61.5 林玉老师
02 刘奕伶
586 一本
02 赵原巧
587 一本
06 黄莹
569 一本
06 雷凯迪
567 一本
06 梁虹
下面介绍具体的操作步骤：
一、 把成绩数据按上表的格式放sheet1表中，把科任教师信息看上述格式放sheet3表
中。
二、 建立一个VBA；选中sheet2表，点
器，打开VBA编辑器。
4 / 7
菜单-- --宏---Visual Basic编辑
精品word.
三、 点插入菜单---模块；双击新建的模块1；再点插入菜单下的过程，输入
过程名，然后进入代码编辑，把下面的代码复制入代码框即可 Public Sub 测试()
Dim x, y, z, v, bj, bx As Long x = 2 z = 2
For v = 2 To 2270
If Sheet1.Cells(z, 11) < 710 Then If Sheet1.Cells(z, 11) >= 567 Then Sheet2.Cells(x, 2) = Sheet1.Cells(z, 1) Sheet2.Cells(x, 1) = Sheet1.Cells(z, 2) Sheet2.Cells(x, 3) = Sheet1.Cells(z, 11) Sheet2.Cells(x, 4) = \"一本\" bj = Sheet1.Cells(z, 2) '语文
If Sheet1.Cells(z, 3) < 112 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 3) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 3) Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 3) x = x + 1 End If '数学
If Sheet1.Cells(z, 4) < 128 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 4) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 4)
5 / 7
精品word.
Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 4) x = x + 1 End If '英语
If Sheet1.Cells(z, 5) < 128 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 5) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 5) Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 5) x = x + 1 End If '政治
If Sheet1.Cells(z, 7) < 71 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 7) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 7) Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 6) x = x + 1 End If '历史
If Sheet1.Cells(z, 8) < 82 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 8) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 8) Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 7) x = x + 1 End If '地理
6 / 7
精品word.
If Sheet1.Cells(z, 9) < 74 Then
Sheet2.Cells(x, 5) = Sheet1.Cells(1, 9) Sheet2.Cells(x, 6) = Sheet1.Cells(z, 9) Sheet2.Cells(x, 7) = Sheet3.Cells(bj + 1, 8) x = x + 1 End If End If End If z = z + 1 Next v End Sub
还有不懂的可以留言。
最新文件---------------- 仅供参考--------------------已改成-----------word文本 --------------------- 方便更改 赠人玫瑰，手留余香。
7 / 7
