ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: zhou19620107

计件工资核算

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-25 09:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
忘得快 发表于 2013-9-8 20:31
大侠你的附件不错!能告知源码学习吗?谢谢!

买本VBA入门或基础的书看看,有一些语言基础,基本的语句结构,能大致看懂语句和简单的调试程序办法(用好F8和F5,暂停等),还有常用的函数,就能用VBA写出功能不错的代码。我是会计也就低水平哦。

TA的精华主题

TA的得分主题

发表于 2013-9-25 17:51 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
zhou19620107 发表于 2013-9-25 09:34
买本VBA入门或基础的书看看,有一些语言基础,基本的语句结构,能大致看懂语句和简单的调试程序办法(用好 ...

想学学大侠的经验,看不到大侠的源代码,遗憾!

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-28 12:16 | 显示全部楼层
******自定义工具栏代码*******
Sub MyTool()
On Error Resume Next
Application.CommandBars("固定资产折旧工具栏").Delete
Dim 工具栏 As CommandBar
Dim 命令按钮 As CommandBarControl
  Set 工具栏 = Application.CommandBars.Add
  With 工具栏
       .Name = "固定资产折旧工具栏"
       .Position = msoBarTop
       .Protection = msoBarNoMove
       .Visible = True
     Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "隐藏"
         .FaceId = 1649
         .OnAction = "M1隐藏"
         .Style = msoButtonIconAndCaptionBelow
       End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "显示"
         .FaceId = 1650
         .OnAction = "M2显示"
         .Style = msoButtonIconAndCaptionBelow
       End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "汇总"
         .FaceId = 504
         .BeginGroup = True
         .OnAction = "M3汇总"
         .Style = msoButtonIconAndCaptionBelow
       End With
     Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "除汇总"
         .FaceId = 605
         .OnAction = "M4除汇总"
         .Style = msoButtonIconAndCaptionBelow
       End With
     Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "类汇总"
         .FaceId = 504
         .OnAction = "M11类汇总"
         .Style = msoButtonIconAndCaptionBelow
       End With
     Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "转下月"
         .FaceId = 159
         .BeginGroup = True
         .OnAction = "M5转下月"
         .Style = msoButtonIconAndCaptionBelow
       End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "插行"
         .FaceId = 295
         .OnAction = "M6插行"
         .Style = msoButtonIconAndCaptionBelow
       End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "删行"
         .FaceId = 293
         .OnAction = "M7删行"
         .Style = msoButtonIconAndCaptionBelow
      End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "年结"
         .FaceId = 592
         .OnAction = "M8年结"
         .Style = msoButtonIconAndCaptionBelow
      End With
    Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "显栏"
         .FaceId = 1653
         .OnAction = "M9显栏"
         .BeginGroup = True
         .Style = msoButtonIconAndCaptionBelow
      End With
      Set 命令按钮 = .Controls.Add
       With 命令按钮
         .Caption = "隐栏"
         .FaceId = 1652
         .OnAction = "M10隐栏"
         .Style = msoButtonIconAndCaptionBelow
      End With
  End With
Set 命令按钮 = Nothing
Set 工具栏 = Nothing
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-28 12:23 | 显示全部楼层
Sub M5转下月()
   Dim n As Integer
   Dim m As Range
   Dim wksheet As Worksheet
   Dim wksheet2 As Worksheet
   ActiveSheet.Unprotect Password:="161602"
   MsgBox "将结转到下月,如执行了操作而又不想转到下月,请不要保存,如已保存可重新打开删除表"
   For Each wksheet In Worksheets
     If wksheet.Name = "12月份" Then 存在 = True
       Next wksheet
       If 存在 = True Then
          aa = MsgBox("已存在12月份表,将要结转下年" & _
             Chr(10) & "结转下年将删除1-12月份表!请先做好备份!", 0, "备份提示")
            If aa = 1 Then GoTo f10
             Else
             ActiveSheet.Copy Before:=Sheets(1)
             Range("j3").Select
             Set m = Range("j3")
                mym = Len(m)
                Select Case mym
                Case Is = 3
                     n = Left(m, 1)
                     n = n + 1
                Case Is = 4
                     n = Left(m, 2)
                     If n = 10 Or n = 11 Then
                        n = n + 1
                     Else
                       MsgBox "请检查表标签是是否正确,请重新选择!"
                       GoTo f10
                     End If
                Case Else
                     MsgBox "请检查表标签是是否正确,请重新选择!"
                     GoTo f10
                End Select
             End If
  '改表名
       Range("j3").Select
       Range("j3").Value = n & "月份"
       For Each wksheet2 In Worksheets
       If wksheet2.Name = n & "月份" Then 存在 = True
          Next wksheet2
       If 存在 = True Then
          MsgBox "请检查是否选错了月份,要结转的月份已存在!请重新选择结转"
          Application.DisplayAlerts = False
          On Error GoTo f10
          ActiveSheet.Delete
          Application.DisplayAlerts = True
           GoTo f10
             Else
         ActiveSheet.Name = Range("j3").Value
         End If
   '开始复制累计折旧
      k = ActiveSheet.[k65536].End(xlUp).Row
        For n = 5 To k
         On Error Resume Next
         J = Application.WorksheetFunction.Round(Cells(n, 8) * (1 - Range("N3")) / Cells(n, 3) / 12, 2)
         Cells(n, 9) = Application.WorksheetFunction.Round(Cells(n, 11), 2)
         Cells(n, 13) = Cells(n, 13).Value
             If Cells(n, 12) - Cells(n, 7) < J And Cells(n, 12) - Cells(n, 7) < 0 Then
                Cells(n, 10) = Cells(n, 8) - Cells(n, 9) - Cells(n, 7)
           
         ElseIf Cells(n, 12) - Cells(n, 7) < 0 And Cells(n, 10) > 0 Then
                Cells(n, 10) = Cells(n, 12) - Cells(n, 7) + Cells(n, 10)
         
         ElseIf Cells(n, 12) - Cells(n, 7) < 0 And Cells(n, 10) = 0 Then
                Cells(n, 10) = 0
         
         ElseIf Cells(n, 12) - Cells(n, 7) < 0 Then
              Cells(n, 10) = Cells(n, 12) - Cells(n, 7) - Cells(n, 10)
         
         ElseIf Cells(n, 12) - Cells(n, 7) = J And Cells(n, 10) < 0 Then
                Cells(n, 10) = 0

         ElseIf Cells(n, 12) - Cells(n, 7) = 0 And Cells(n, 10) > 0 Then
                Cells(n, 10) = 0
         
         End If
         Cells(n, 13) = Cells(n, 13) + Cells(n, 10)
         If Cells(n, 10).Value > 0 Then Cells(n, 16) = Cells(n, 16) + 1
       Next n
       GoTo f11
f10:
     ActiveWindow.Close
f11:
    '除汇总
       ActiveSheet.Unprotect Password:="161602"
       Cells.Select
       Selection.RemoveSubtotal
       Range("A5").Select
     M3汇总     '调用
     ActiveSheet.Protect Password:="161602"
     Worksheets(2).Select
     ActiveSheet.Protect Password:="161602"
     Worksheets(1).Select
     End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-9-28 12:45 | 显示全部楼层
V2.5的增加了“已折旧年限”

固定资产折旧表V2.5.rar

36.67 KB, 下载次数: 174

TA的精华主题

TA的得分主题

发表于 2013-11-29 09:04 | 显示全部楼层
LZ辛苦,下载来学习借鉴一下。多谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-2-4 16:41 | 显示全部楼层
春节这几天整了个收发存核算

收发存核算V1.01.rar

47.74 KB, 下载次数: 358

TA的精华主题

TA的得分主题

发表于 2014-6-19 13:20 | 显示全部楼层
su_jerry 发表于 2011-8-3 15:44
固定资产用的,不是计件工资

楼主不是说了吗33楼下载,刚下载了,还没有用,看样子设计的很好

TA的精华主题

TA的得分主题

发表于 2014-6-19 13:21 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2014-6-19 15:02 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
工序更改不了,是收费的吗,楼主,能否共享一下呀
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 09:53 , Processed in 0.061424 second(s), 7 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表