Skip to main content
 Web开发网 » office教程 » excel教程

[软件工具]如果平时很多Excel操作,建议学一些宏程序,简单易学

2021年11月25日100百度已收录

我的工作涉及大量的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

评论列表暂无评论
发表评论
微信