Vb对excel操作的实例

Vb对excel操作的实例

最近，由于工作关系，我用vb6.0做了一个计算成绩的软件，由于我不会数据库技术，同行对excel应用又比较普遍，所以就用vb6.0操作excel完成了成绩统计的任务。

先说说窗体，很简单，只运用了菜单，由此来调用程序代码。截图如下：

窗体命名为excel操作，共五个一级菜单。

创建表册用来制作所用表格。

计算成绩用来算成绩。

模拟运算用来测试软件，设置了两个子菜单，一个填随机生成的数据。有了数据就可以计算成绩了，看看效果如何。

测试完了就可以清空数据了，清空成绩册中的基础数据以后再计算一次成绩就基本可以使表册恢复原样了。其实，我这是多此一举，回头一想，只需要重新创建所用表册就行了。

还画蛇添足了俩菜单：计算器和退出。

代码也贴出来共享一下。

创建表册：一年级：

Private Sub ynjkb_Click()

Call 建空表(10)

Call 工作表命名(1)

Call 成绩册(1)

Unload excel操作

End Sub

创建表册：二年级：

Private Sub enjkb_Click()

Call 建空表(10)

Call 工作表命名(2)

Call 成绩册(2)

Unload excel操作

End Sub

三至六年级略了吧。

创建表册：学校总评：

Private Sub xxzp_Click()

nj(1) = "一年级": nj(2) = "二年级": nj(3) = "三年级": nj(4) = "四年级": nj(5) = "五年级": nj(6) = "六年级"

Call 建空表(2)

'建立积分表

Sheets(1).Name = "学校积分"

Sheets(2).Name = "积分"

Sheets("学校积分").Select

Range("a1:i1").Merge

[a1] = "学校积分统计表": [a2] = "学校": [a3] = "南村小学": [a4] = "东风小学": [a5] = "兴中小学": [a6] = "尧场小学"

nj(1) = "一年级": nj(2) = "二年级": nj(3) = "三年级": nj(4) = "四年级": nj(5) = "五年级": nj(6) = "六年级"

For i = 1 To 6

Cells(2, i + 1) = nj(i) + "积分"

Next

Cells(2, 8) = "均积分": Cells(2, 9) = "名次" Range([a1], [i6]).Select

Selection.HorizontalAlignment = xlCenter

Call 表格加线(Range([a2], [i6]))

Call 横排(6, 9)

ActiveSheet.PageSetup.Orientation = xlLandscape Unload excel操作

End Sub

创建表册：上报：

Private Sub shangbao_Click()

Call 建空表(2)

Sheets(1).Name = "中心校"

Sheets("中心校").Select

Call 上报表("中心校")

Sheets(2).Name = "普小"

Sheets("普小").Select

Call 上报表("普小")

Unload excel操作

End Sub

计算成绩：一年级：

Private Sub yinianji_Click()

Call 打开工作表

Call 算成绩(1)

kmb(1) = "语文": kmb(2) = "数学": kmb(3) = "英语" Sheets(kmb(1)).Select

For i = 1 To 8 '记录一年级语文数据

With bj(i)

.xxmc = Cells(2, i + 1)

.dkjs = Cells(3, i + 1)

.xkrs = Cells(4, i + 1)

.xkzf = Cells(5, i + 1)

.xkjgr = Cells(6, i + 1)

.xkyxr = Cells(7, i + 1)

.xkjf = Cells(8, i + 1)

.bjkm = kmb(1)

.njxh = 1

End With

Next

Sheets(kmb(2)).Select

For i = 1 To 8 '记录一年级数学数据

With bj(i + 8)

.xxmc = Cells(2, i + 1)

.dkjs = Cells(3, i + 1)

.xkrs = Cells(4, i + 1)

.xkzf = Cells(5, i + 1)

.xkjgr = Cells(6, i + 1)

.xkyxr = Cells(7, i + 1)

.xkjf = Cells(8, i + 1)

.bjkm = kmb(2)

.njxh = 1

End With

Next

Dim hgrs(8) '记录各学校合格人数

For i = 1 To 8

Sheets(xx(i)).Select

szl = Application.WorksheetFunction.Match("总分", Range([a2], [f2])) '总分所在列即合格人数所在列

szh = Application.WorksheetFunction.Match("合格人数", Range(Cells(2, szl), Cells(80, szl))) '“合格人数”所在行hgrs(i) = Cells(szh + 2, szl)

Next

'向学校总评表过录一年级数据

nj(1) = "一年级": nj(2) = "二年级": nj(3) = "三年级": nj(4)

= "四年级": nj(5) = "五年级": nj(6) = "六年级"

Workbooks.Open FileName:=ActiveWorkbook.Path & "\学校总评.xls"

For i = 1 To 16

With Sheets("积分")

Sheets("积分").Select

[a1] = "年级": [a2] = "学科": [a3] = "学校": [a4] = "人数": [a5] = "总分": [a6] = "及格人数": [a7] = "优秀人数": [a8] = "积分"

.Cells(1, i + 1) = nj(bj(i).njxh)

.Cells(2, i + 1) = bj(i).bjkm

.Cells(3, i + 1) = bj(i).xxmc

.Cells(4, i + 1) = bj(i).xkrs

.Cells(5, i + 1) = bj(i).xkzf

.Cells(6, i + 1) = bj(i).xkjgr

.Cells(7, i + 1) = bj(i).xkyxr

.Cells(8, i + 1) = bj(i).xkjf

End With

Next

Workbooks.Open FileName:=ActiveWorkbook.Path & "\上报.xls"

With Sheets("中心校") '过录中心校成绩

.Cells(bj(1).njxh * 2 + 2, 3) = bj(1).xkrs + bj(2).xkrs + bj(6).xkrs '语文

.Cells(bj(1).njxh * 2 + 2, 4) = bj(1).xkzf + bj(2).xkzf + bj(6).xkzf

.Cells(bj(1).njxh * 2 + 2, 5) = Round(.Cells(bj(1).njxh * 2 + 2, 4) / .Cells(bj(1).njxh * 2 + 2, 3), 2)

.Cells(bj(1).njxh * 2 + 2, 6) = bj(1).xkjgr + bj(2).xkjgr + bj(6).xkjgr

.Cells(bj(1).njxh * 2 + 2, 7) = bj(1).xkyxr + bj(2).xkyxr + bj(6).xkyxr

.Cells(bj(1).njxh * 2 + 2, 8) = hgrs(1) + hgrs(2) + hgrs(6)

.Cells(bj(1).njxh * 2 + 3, 3) = bj(9).xkrs + bj(10).xkrs + bj(14).xkrs '数学

.Cells(bj(1).njxh * 2 + 3, 4) = bj(9).xkzf + bj(10).xkzf + bj(14).xkzf

.Cells(bj(1).njxh * 2 + 3, 5) = Round(.Cells(bj(1).njxh * 2 + 3, 4) / .Cells(bj(1).njxh * 2 + 3, 3), 2)

.Cells(bj(1).njxh * 2 + 3, 6) = bj(9).xkjgr + bj(10).xkjgr + bj(14).xkjgr

.Cells(bj(1).njxh * 2 + 3, 7) = bj(9).xkyxr + bj(10).xkyxr + bj(14).xkyxr

.Cells(bj(1).njxh * 2 + 3, 8) = hgrs(1) + hgrs(2) + hgrs(6)

End With

With Sheets("普小") '过录普小成绩

.Cells(bj(1).njxh * 2 + 2, 3) = bj(3).xkrs + bj(4).xkrs + bj(5).xkrs + bj(7).xkrs + bj(8).xkrs '语文

.Cells(bj(1).njxh * 2 + 2, 4) = bj(3).xkzf + bj(4).xkzf + bj(5).xkzf + bj(7).xkzf + bj(8).xkzf

.Cells(bj(1).njxh * 2 + 2, 5) = Round(.Cells(bj(1).njxh * 2 + 2, 4) / .Cells(bj(1).njxh * 2 + 2, 3), 2)

.Cells(bj(1).njxh * 2 + 2, 6) = bj(3).xkjgr + bj(4).xkjgr + bj(5).xkjgr + bj(7).xkjgr + bj(8).xkjgr

.Cells(bj(1).njxh * 2 + 2, 7) = bj(3).xkyxr + bj(4).xkyxr + bj(5).xkyxr + bj(7).xkyxr + bj(8).xkyxr

.Cells(bj(1).njxh * 2 + 2, 8) = hgrs(3) + hgrs(4) + hgrs(5) + hgrs(7) + hgrs(8)

.Cells(bj(1).njxh * 2 + 3, 3) = bj(11).xkrs + bj(12).xkrs + bj(13).xkrs + bj(15).xkrs + bj(16).xkrs '数学

.Cells(bj(1).njxh * 2 + 3, 4) = bj(11).xkzf + bj(12).xkzf + bj(13).xkzf + bj(15).xkzf + bj(16).xkzf

.Cells(bj(1).njxh * 2 + 3, 5) = Round(.Cells(bj(1).njxh * 2 + 3, 4) / .Cells(bj(1).njxh * 2 + 3, 3), 2)

.Cells(bj(1).njxh * 2 + 3, 6) = bj(11).xkjgr + bj(12).xkjgr + bj(13).xkjgr + bj(15).xkjgr + bj(15).xkjgr

.Cells(bj(1).njxh * 2 + 3, 7) = bj(11).xkyxr + bj(12).xkyxr + bj(13).xkyxr + bj(15).xkyxr + bj(16).xkyxr

.Cells(bj(1).njxh * 2 + 3, 8) = hgrs(3) + hgrs(4) + hgrs(5) + hgrs(7) + hgrs(8)

End With

Unload excel操作

End Sub

计算成绩：二年级略。

计算成绩：三年级：

Private Sub sannianji_Click()

Call 打开工作表

Call 算成绩(3)

kmb(1) = "语文": kmb(2) = "数学": kmb(3) = "英语"

Sheets(kmb(1)).Select

For i = 1 To 5 '记录三年级语文数据

With bj(i)

.xxmc = Cells(2, i + 1)

.dkjs = Cells(3, i + 1)

.xkrs = Cells(4, i + 1)

.xkzf = Cells(5, i + 1)

.xkjgr = Cells(6, i + 1)

.xkyxr = Cells(7, i + 1)

.bjkm = kmb(1)

.njxh = 3

End With

Next

Sheets(kmb(2)).Select

For i = 1 To 5 '记录三年级数学数据With bj(i + 5)

.xxmc = Cells(2, i + 1)

.dkjs = Cells(3, i + 1)

.xkrs = Cells(4, i + 1)

.xkzf = Cells(5, i + 1)

.xkjgr = Cells(6, i + 1)

.xkyxr = Cells(7, i + 1)

.xkjf = Cells(8, i + 1)

.bjkm = kmb(2)

.njxh = 3

End With

Next

Sheets(kmb(3)).Select

For i = 1 To 5 '记录三年级英语数据With bj(i + 10)

.dkjs = Cells(3, i + 1)

.xkrs = Cells(4, i + 1)

.xkzf = Cells(5, i + 1)

.xkjgr = Cells(6, i + 1)

.xkyxr = Cells(7, i + 1)

.xkjf = Cells(8, i + 1)

.bjkm = kmb(3)

.njxh = 3

End With

Next

xx(1) = "南村1": xx(2) = "南村2": xx(3) = "兴中": xx(4) = "东风": xx(5) = "尧场"

Dim hgrs(5) '记录各学校合格人数

For i = 1 To 5

Sheets(xx(i)).Select

szl = Application.WorksheetFunction.Match("总分", Range([a2], [f2])) '总分所在列即合格人数所在列

szh = Application.WorksheetFunction.Match("合格人数", Range(Cells(2, szl), Cells(80, szl))) '“合格人数”所在行hgrs(i) = Cells(szh + 2, szl)

Next

'向学校总评表过录积分

nj(1) = "一年级": nj(2) = "二年级": nj(3) = "三年级": nj(4) = "四年级": nj(5) = "五年级": nj(6) = "六年级"

Workbooks.Open FileName:=ActiveWorkbook.Path & "\学校总评.xls"

For i = 1 To 15

With Sheets("积分")

[a21] = "年级": [a22] = "学科": [a23] = "学校": [a24] = "人数": [a25] = "总分": [a26] = "及格人数": [a27] = "优秀人数": [a28] = "积分"

.Cells(21, i + 1) = nj(bj(i).njxh)

.Cells(22, i + 1) = bj(i).bjkm

.Cells(23, i + 1) = bj(i).xxmc

.Cells(24, i + 1) = bj(i).xkrs

.Cells(25, i + 1) = bj(i).xkzf

.Cells(26, i + 1) = bj(i).xkjgr

.Cells(27, i + 1) = bj(i).xkyxr

.Cells(28, i + 1) = bj(i).xkjf

End With

Next

Workbooks.Open FileName:=ActiveWorkbook.Path & "\上报.xls"

With Sheets("中心校") '过录中心校成绩

.Cells(bj(1).njxh * 3 - 1, 3) = bj(1).xkrs + bj(2).xkrs '语文.Cells(bj(1).njxh * 3 - 1, 4) = bj(1).xkzf + bj(2).xkzf

.Cells(bj(1).njxh * 3 - 1, 5) = Round(.Cells(bj(1).njxh * 3 - 1, 4) / .Cells(bj(1).njxh * 3 - 1, 3), 2)

.Cells(bj(1).njxh * 3 - 1, 6) = bj(1).xkjgr + bj(2).xkjgr

.Cells(bj(1).njxh * 3 - 1, 7) = bj(1).xkyxr + bj(2).xkyxr

.Cells(bj(1).njxh * 3 - 1, 8) = hgrs(1) + hgrs(2)

.Cells(bj(1).njxh * 3, 3) = bj(6).xkrs + bj(7).xkrs '数学.Cells(bj(1).njxh * 3, 4) = bj(6).xkzf + bj(7).xkzf

.Cells(bj(1).njxh * 3, 5) = Round(.Cells(bj(1).njxh * 3, 4) / .Cells(bj(1).njxh * 3, 3), 2)

.Cells(bj(1).njxh * 3, 6) = bj(6).xkjgr + bj(7).xkjgr

.Cells(bj(1).njxh * 3, 7) = bj(6).xkyxr + bj(7).xkyxr

.Cells(bj(1).njxh * 3, 8) = hgrs(1) + hgrs(2)

.Cells(bj(1).njxh * 3 + 1, 3) = bj(11).xkrs + bj(12).xkrs '英语

.Cells(bj(1).njxh * 3 + 1, 4) = bj(11).xkzf + bj(12).xkzf

.Cells(bj(1).njxh * 3 + 1, 5) = Round(.Cells(bj(1).njxh * 3 + 1, 4) / .Cells(bj(1).njxh * 3 + 1, 3), 2)

.Cells(bj(1).njxh * 3 + 1, 6) = bj(11).xkjgr + bj(12).xkjgr

.Cells(bj(1).njxh * 3 + 1, 7) = bj(11).xkyxr + bj(12).xkyxr

.Cells(bj(1).njxh * 3 + 1, 8) = hgrs(1) + hgrs(2)

End With

With Sheets("普小") '过录普小成绩

.Cells(bj(1).njxh * 3 - 1, 3) = bj(3).xkrs + bj(4).xkrs + bj(5).xkrs '语文

.Cells(bj(1).njxh * 3 - 1, 4) = bj(3).xkzf + bj(4).xkzf + bj(5).xkzf

.Cells(bj(1).njxh * 3 - 1, 5) = Round(.Cells(bj(1).njxh * 3 - 1, 4) / .Cells(bj(1).njxh * 3 - 1, 3), 2)

.Cells(bj(1).njxh * 3 - 1, 6) = bj(3).xkjgr + bj(4).xkjgr + bj(5).xkjgr

.Cells(bj(1).njxh * 3 - 1, 7) = bj(3).xkyxr + bj(4).xkyxr + bj(5).xkyxr

.Cells(bj(1).njxh * 3 - 1, 8) = hgrs(3) + hgrs(4) + hgrs(5)

.Cells(bj(1).njxh * 3, 3) = bj(8).xkrs + bj(9).xkrs + bj(10).xkrs '数学

.Cells(bj(1).njxh * 3, 4) = bj(8).xkzf + bj(9).xkzf + bj(10).xkzf

.Cells(bj(1).njxh * 3, 5) = Round(.Cells(bj(1).njxh * 3, 4) / .Cells(bj(1).njxh * 3, 3), 2)

.Cells(bj(1).njxh * 3, 6) = bj(8).xkjgr + bj(9).xkjgr + bj(10).xkjgr

.Cells(bj(1).njxh * 3, 7) = bj(8).xkyxr + bj(9).xkyxr + bj(10).xkyxr

.Cells(bj(1).njxh * 3, 8) = hgrs(3) + hgrs(4) + hgrs(5)

.Cells(bj(1).njxh * 3 + 1, 3) = bj(13).xkrs + bj(14).xkrs + bj(15).xkrs '英语

.Cells(bj(1).njxh * 3 + 1, 4) = bj(13).xkzf + bj(14).xkzf + bj(15).xkzf

.Cells(bj(1).njxh * 3 + 1, 5) = Round(.Cells(bj(1).njxh * 3 + 1, 4) / .Cells(bj(1).njxh * 3 + 1, 3), 2)

.Cells(bj(1).njxh * 3 + 1, 6) = bj(13).xkjgr + bj(14).xkjgr + bj(15).xkjgr

.Cells(bj(1).njxh * 3 + 1, 7) = bj(13).xkyxr + bj(14).xkyxr + bj(15).xkyxr

.Cells(bj(1).njxh * 3 + 1, 8) = hgrs(3) + hgrs(4) + hgrs(5)

End With

Unload excel操作

End Sub

计算成绩：三至六年级略。

计算成绩：学校总评：

Private Sub 学校总评_Click()

Call 打开工作表

For i = 1 To 6

Call 算学校积分(i)

Next

Sheets("学校积分").Select

For i = 3 To 6

Range("h" & i) = Round(Application.WorksheetFunction.Sum(Range(Range("b" & i), Range("g" & i))) / 6, 2)

Next

For i = 3 To 6

Range("i" & i) = Application.WorksheetFunction.Rank(Range("h" & i), Range([h3], [h6]))

Next

Unload excel操作

End Sub

模拟运算：随机填成绩：一年级：

Private Sub synj_Click()

Call 打开工作表

Call 填数据(1)

Unload excel操作

End Sub

模拟运算：随机填成绩：二年级至六年级略。

模拟运算：清空成绩册：一年级：

Private Sub qynj_Click()

Call 打开工作表

Call 清数据(1)

Unload excel操作

End Sub

模拟运算：清空成绩册：二年级至六年级略。

计算器：

Private Sub jsq_Click()

Shell "calc.exe"

End Sub

退出：

Private Sub tc_Click()

Unload excel操作

End Sub

框架已经完成，可以看出，卸载窗体的动作很频繁。这是我调试的结果，这样才能保证每次的动作都能顺利完成。我想这就是单窗体的特点吧。

被调用的程序模块也挺多的，系统包也调用了，最频繁的就是打开文件对话框的调用。

Private Sub 打开工作表()

Application.FindFile

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True '设置EXCEL对象可见（或不可见）End Sub

哦，还得说明一下，对excel的操作前提：

Dim xlApp As Excel.Application

Dim xlBook As Excel.Workbook

Dim xlSheet As Excel.Worksheet

本软件中，我第一次用了自定义类的数据类型。

Private Type banji

xxmc As String

bjkm As String

njxh As Integer

xkrs As Integer

dkjs As String

xkzf As Integer

xkjgr As Integer

xkyxr As Integer

xkjf As Long

End Type

并设了一数组Dim bj(16) As banji来从年级成绩册向学校总评表过录数据。设了八个学校名称Dim xx(8)，设了3个科目表Dim kmb(1 To 3) As String，六个年级Dim nj(1 To 6)

As String，班级人数为六个年级八个学校的二维数组Dim gbrs(6, 8)。

至于其它程序模块都是我以前vba用过的，在我的空间里有，在此不再赘述。