我的工作涉及大量的Excel 操作,最初还是用公式计算,后来无意中接触了宏程序。其实一些简单的旧痕有用处了,一下是一个我常用的程序(鉴于机密问题,没有给出相关表格):希望能给做同类工作的人一点建议:
Sub 创建表格()
' 创建表格 Macro
' 宏由 liq 录制,时间: 2005-4-1
' 快捷键: Ctrl+M
'以下定义程序所需要的一些数据
Dim path1, file1, file2, string1 As String
Dim mybook1, mybook2, mybook3 As Workbook
Dim a, b, c, i As Integer
Dim oilamount737, oilamount757, oilcost737, oilcost757, oliprice As Double
Dim othervc737, othervc757, fc737, fc757, periodcost37, periodcost757 As Double
Dim tonkm, passengerkm, flighthour737, flighthour757 As Double
Dim tcost737, tcost757, tcost, othercost737, othercost757, othercost As Double
Dim transcost, othertranscost As Double
'设定工作表所在的路径,该路径下至少要有加油情况05和该月的成本报表
path1 = "D:\油价\"
'接下来取出时间值
Workbooks("油价变动影响表.xls").Activate
Sheets(1).Select
a = Range("b203").Value - 2000
b = Range("c203").Value
'判断计算的时间的正确性
string1 = "计算的月份为" & 200 & a & "年" & b & "月"
c = MsgBox(string1, vbOKCancel)
If c <> 1 Then
MsgBox ("请在表格最下方修改时间设置")
Exit Sub
End If
Set mybook1 = ActiveWorkbook
'以下打开需要的两个表格,为防止出错,要先确认这些表存在。
file1 = path1 & "加油情况05.xls"
If FileExists(file1) Then
Workbooks.Open Filename:=file1, UpdateLinks:=0
Set mybook2 = ActiveWorkbook
Else
MsgBox ("加油情况05不存在")
Exit Sub
End If
'接下来打开第二个表格
If b < 10 Then
file2 = path1 & "新报表格式" & 0 & a & 0 & b & ".xls"
Else
file2 = path1 & "新报表格式" & 0 & a & b & ".xls"
End If
If FileExists(file2) Then
Workbooks.Open Filename:=file2, UpdateLinks:=0
Set mybook3 = ActiveWorkbook
Else
MsgBox ("该月的报表不存在")
Exit Sub
End If
'现在开始取出所要的数据
'油价
mybook2.Activate
Sheets(5).Select
oilprice = Cells(3 + b, 7).Value
If oilprice <= 0 Then
MsgBox ("航油价格不能为0或小于0")
Exit Sub
End If
ActiveWorkbook.Close
'MsgBox (oilprice)
'取出耗油量
mybook3.Activate
Sheets(2).Select
oilcost737 = Cells(12, 3).Value + Cells(12, 4).Value + Cells(12, 5).Value
'MsgBox (oilcost737)
oilcost757 = Cells(12, 6).Value
'MsgBox (oilcost757)
oilamount737 = oilcost737 / oilprice
oilamount757 = oilcost757 / oilprice
'下面找出其他变动/固定成本及期间费用,分机型
Sheets(12).Select
othervc737 = Cells(41, 3).Value + Cells(41, 4).Value + Cells(41, 5).Value - oilcost737
'MsgBox (othervc737)
othervc757 = Cells(41, 6).Value - oilcost757
'MsgBox (othervc757)
fc757 = Cells(18, 6).Value
fc737 = Cells(18, 7).Value - fc757
'MsgBox (fc737)
'MsgBox (fc757)
periodcost737 = Cells(73, 3).Value + Cells(73, 4).Value + Cells(73, 5).Value
periodcost737 = periodcost737 + Cells(84, 3).Value + Cells(84, 4).Value + Cells(84, 5).Value
periodcost737 = periodcost737 + Cells(48, 3).Value + Cells(48, 4).Value + Cells(48, 5).Value
periodcost737 = periodcost737 + Cells(26, 3).Value + Cells(26, 4).Value + Cells(26, 5).Value
'MsgBox (periodcost737)
periodcost757 = Cells(73, 6).Value + Cells(84, 6).Value + Cells(48, 6).Value
periodcost757 = periodcost757 + Cells(26, 6).Value
'MsgBox (periodcost757)
tcost737 = oilcost737 + othervc737 + fc737 + periodcost737
'MsgBox (tcost737)
tcost757 = oilcost757 + othervc757 + fc757 + periodcost757
'MsgBox (tcost757)
tcost = tcost737 + tcost757
'MsgBox (tcost)
'除航油以外的成本总计
othercost737 = tcost737 - oilcost737
othercost757 = tcost757 - oilcost757
othercost = othercost737 + othercost757
'生产数据
Sheets(9).Select
flighthour737 = Cells(13, 5).Value + Cells(13, 6).Value + Cells(13, 7).Value
If flighthour737 <= 0 Then
MsgBox ("737飞行小时不能为0或小于0")
Exit Sub
End If
'MsgBox (flighthour737)
flighthour757 = Cells(13, 8).Value
If flighthour757 <= 0 Then
MsgBox ("飞行小时不能为0或小于0")
Exit Sub
End If
'MsgBox (flighthour757)
tonkm = Cells(21, 9).Value * 10000
If tonkm <= 0 Then
MsgBox ("吨公里不能为0或小于0")
Exit Sub
End If
'MsgBox (tonkm)
passengerkm = Cells(22, 9).Value * 10000 / Cells(23, 9).Value * 100
If passengerkm <= 0 Then
MsgBox ("客公里不能为0或小于0")
Exit Sub
End If
'MsgBox (passengerkm)
'将运输成本单独列出
Sheets(1).Select
transcost = Cells(5, 3).Value
othertranscost = transcost - oilcost737 - oilcost757
'MsgBox (transcost)
ActiveWorkbook.Close
'接下来将进行计算,变动的部分为航油
mybook1.Activate
Sheets(1).Select
For i = 2 To 202
oilprice = Cells(i, 1).Value
oilcost737 = oilamount737 * oilprice
oilcost757 = oilamount757 * oilprice
Cells(i, 2).Value = (oilcost737 + oilcost757) / (oilcost737 + oilcost757 + othercost)
Cells(i, 3).Value = oilcost737 / flighthour737
Cells(i, 4).Value = oilcost757 / flighthour757
Cells(i, 5).Value = (oilcost737 + othervc737) / flighthour737
Cells(i, 6).Value = (oilcost757 + othervc757) / flighthour757
Cells(i, 7).Value = (oilcost737 + othercost737) / flighthour737
Cells(i, 8).Value = (oilcost757 + othercost757) / flighthour757
'以下五个数据的单位为分
Cells(i, 9).Value = (oilcost737 + oilcost757) / tonkm * 100
Cells(i, 10).Value = (oilcost737 + oilcost757 + othertranscost) / tonkm * 100
Cells(i, 11).Value = (oilcost737 + oilcost757 + othervc737 + othervc757) / tonkm * 100
Cells(i, 12).Value = (oilcost737 + oilcost757 + othercost) / tonkm * 100
Cells(i, 13).Value = (oilcost737 + oilcost757 + othervc737 + othervc757) / passengerkm * 100
Next i
End Sub
Private Function FileExists(fname) As Boolean
' Returns TRUE if the file exists
Dim x As String
x = Dir(fname)
If x <> "" Then FileExists = True _
Else FileExists = False
End Function
Private Function WorkbookIsOpen(wbname) As Boolean
' Returns TRUE if the workbook is open
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function