VBA初学:零件成本统计之一(任务汇总)

经过前期一年多对金蝶K3生产任务流程和操作的改造和优化,现在总算可以将零件加工各个环节的成本进行归集了。
原本想写存储过程,通过直接SQL报表做到K3中去的,但财务原本就是用EXCEL,可以方便调整和保存,加上还有一部分成本费用需要先分摊再做进去的,所以用VBA做了这个表格。

第一步,是获取机加任务及工时
在目录页中,各按钮代码如下,顺便将点击日期保存,以备查
在这里插入图片描述

Private Sub CommandButton1_Click()
 Startview.Show 0
 CommandButton1.Enabled = False
 ActiveSheet.Range("C3") = Now()
End Sub

Private Sub CommandButton2_Click()
  summary.statistical
  CommandButton2.Enabled = False
  ActiveSheet.Range("C4") = Now()
End Sub

Private Sub CommandButton3_Click()
  count.count
  CommandButton3.Enabled = False
  ActiveSheet.Range("C6") = Now()
End Sub

Private Sub CommandButton4_Click()
CommandButton1.Enabled = True
End Sub

Private Sub CommandButton5_Click()
CommandButton2.Enabled = True
End Sub

Private Sub CommandButton6_Click()
CommandButton3.Enabled = True
End Sub


Private Sub CommandButton7_Click()
  CLWX_JE.getje
  CommandButton7.Enabled = False
  ActiveSheet.Range("C5") = Now()
End Sub

Private Sub CommandButton8_Click()
CommandButton7.Enabled = True
End Sub

点击“获取任务”会跳出一个界面,点击是后进行查询。
在这里插入图片描述

“确认”按钮代码如下

  
 Option Explicit
 
 Public daymark As Boolean

 '获取传入月份的最大日期

Function maxday(year As Integer, month As Integer) As Integer

  maxday = Day(DateSerial(year, month + 1, 1) - 1)
 
End Function

'确认,获取任务
Private Sub ButtonEnter_Click()
 gettask.getdate
   

End Sub

'起始年的CHANGE事件
Private Sub ComboBox1_Change()
 Dim i As Integer
 For i = 2000 To 3000
     Me.ComboBox1.AddItem i
 Next
 
End Sub
'起始年变更后获取起始日期
Private Sub ComboBox1_Click()
    Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始月的CHANGE事件
Private Sub ComboBox2_Change()
 Me.ComboBox2.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub

'起始月变更后获取起始日期
Private Sub ComboBox2_Click()
      Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
  Dim i As Integer
  Me.ComboBox3.Clear
    For i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)
      Me.ComboBox3.AddItem i
    Next
End Sub
'起始日的CHANGE事件
Private Sub ComboBox3_Change()
'   当点击日期时,进行选择
    Dim i As Integer
    For i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)
      Me.ComboBox3.AddItem i
    Next
  
End Sub
'起始日变更后获取起始日期
Private Sub ComboBox3_Click()
   Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始日变更后确认起始日期
Private Sub ComboBox3_Enter()
    Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
    If Me.ComboBox2.Value > 12 Or Me.ComboBox2.Value <= 0 Then
        MsgBox "起始月份有错误"
    End If
    If Me.ComboBox3.Value > maxday(Me.ComboBox1.Value, Me.ComboBox2.Value) Or Me.ComboBox3.Value <= 0 Then
        MsgBox "起始日期有错误"
    End If
    

End Sub
'结束年的CHANGE事件
Private Sub ComboBox4_Change()
  Dim i As Integer
 For i = 2000 To 3000
     Me.ComboBox4.AddItem i
 Next
 
End Sub

'结束年变更后获取结束日期
Private Sub ComboBox4_Click()
  Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'结束月的CHANGE事件
Private Sub ComboBox5_Change()
 Me.ComboBox5.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub
'结束月变更后获取结束日期
Private Sub ComboBox5_Click()
     Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
  '当点击月份要做更改时,日期随之变化
    Dim i As Integer
    Me.ComboBox6.Clear
    For i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)
      Me.ComboBox6.AddItem i
    Next


End Sub

'结束日的CHANGE事件
Private Sub ComboBox6_Change()
 '   当点击日期时,进行选择
    Dim i As Integer
    For i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)
      Me.ComboBox6.AddItem i
    Next

End Sub
'结束日变更后获取结束日期
Private Sub ComboBox6_Click()
 Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'结束日确认后获取结束日期
Private Sub ComboBox6_Enter()
    Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
    If Me.ComboBox5.Value > 12 Or Me.ComboBox5.Value <= 0 Then
        MsgBox "结束月份有错误"
    End If
    If Me.ComboBox6.Value > maxday(Me.ComboBox4.Value, Me.ComboBox5.Value) Or Me.ComboBox6.Value <= 0 Then
        MsgBox "结束日期有错误"
    End If
    
End Sub

'界面初始化
Private Sub UserForm_Initialize()
'    daymark = True
 
    Me.ComboBox1.Value = year(Now())

    Me.ComboBox2.Value = month(Now())

    Me.ComboBox3.Value = Day(Now())
    
    Me.ComboBox4.Value = year(Now())

    Me.ComboBox5.Value = month(Now())

    Me.ComboBox6.Value = Day(Now())
      Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
      Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
      Me.Sdate.Visible = False
      Me.Edate.Visible = False
      
End Sub

点击确认后,调用 gettask.getdate,获取起始至结束日期内的任务

 Sub getdate()


   Dim sqlstr As String
    Dim WS As Worksheet
    Dim rng As Range
    Dim sheetName As String
    Dim i As Long, MAXRGN As Long
    Dim objRec
    Dim objConn
    Dim Sdate As Variant, Edate As Variant
    Dim response As VbMsgBoxResult





Application.ScreenUpdating = False  '关闭屏幕更新,加快程序运行
Application.DisplayAlerts = False   '不显示警告信息

    
   '获取起止时间
    Sdate = Startview.Sdate.Caption
    Edate = Startview.Edate.Caption
    
     
    
    If Sdate <= Edate Then
       response = MsgBox("查询的日期是:" & Sdate & "至" & Edate & "吗?", vbQuestion + vbYesNo, "确认")
       If response = vbYes Then
       GoTo continue
       Else
       Exit Sub
       End If
    Else
        MsgBox "查询时间段设置有误,请检查"
        Exit Sub
    End If
continue:
    Unload Startview


'''''''''检查工作表是否存在,不存在则新建一个
      
    ' 设置要检查的工作表名称
    sheetName = "机加任务及工时"
'    ' 遍历工作簿中的所有工作表,检查是否存在同名工作表
    For Each WS In ThisWorkbook.Sheets
     If WS.Name = sheetName Then
        i = 1
     End If
    Next
    '如果没有则新增
    If i = 0 Then
      Set WS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))
      WS.Name = sheetName
    End If
    '清除原有数据
    ActiveWorkbook.Sheets(sheetName).Select
     MAXRGN = Worksheets(sheetName).Range("a" & Rows.count).End(xlUp).Row
    If MAXRGN <> 0 Then
      Set rng = ActiveSheet.Range("A1:AZ" & MAXRGN)
      rng.Borders.LineStyle = xlNone  ' 移除边框
      rng.Clear ' 清除数据
      
    End If
    

'查询语句
    sqlstr = sqlstr + "  select t1.finterid,t1.FBillNo ,t_Item.fname type,t1.FNote,t2.FNumber,t2.FName, t2.FModel,t1.FQty,  "
    sqlstr = sqlstr + " convert(varchar,T1.FCommitDate,23) rwxdrq,convert(varchar,t1.fheadselfj01111,23) rkrq,   "
    sqlstr = sqlstr + "t4.FItemID,t4.FName,t3.Fmaketime   from icmo t1 inner join t_icitem  t2 on t1.fitemid=t2.FItemID "
    sqlstr = sqlstr + " left join t_BOS257800028Entry2  t3  on t3.FID_SRC=t1.FInterID and t3.FBillNo_SRC1=t1.FBillNo "
    sqlstr = sqlstr + " left join t_Item_3005 t4 on t3.FBase4=t4.FItemID "
    sqlstr = sqlstr + " left join t_Item on t_item.fitemid=t1.FHeadSelfJ01100 and t_item.FItemClassID=3002 "
    sqlstr = sqlstr + "where t1.fheadselfj01111 >=" & "'" & Sdate & "'" & "  and t1.fheadselfj01111<=" & "'" & Edate & "'" & "order by t1.finterid"
''''''''''''''''''''''''''''''''''''''''

'''使用方法一或方法二时解除注释
''''定义连接对象
    Set objRec = CreateObject("ADODB.Recordset")
    Set objConn = CreateObject("ADODB.Connection")
''''''''''''''''''''''''''''''''''''''''''
'''方法一: 数据量大时速度较慢
''        '执行查询并获取结果集
''    连接数据库并执行SQL语句
    objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"
    objConn.Open
     Set objRec = objConn.Execute(sqlstr)
     If Not objRec.EOF Then

''    '将结果集保存到工作表
    Set WS = ThisWorkbook.Worksheets(sheetName) '
    '将标题写入工作表
     For i = 0 To objRec.Fields.count - 1
        WS.Cells(1, i + 1).Value = objRec.Fields(i).Name
     Next i
    ActiveSheet.Range("A2").CopyFromRecordset objRec
''使用方法一或方法二时解除注释
''    关闭记录集和连接
    objRec.Close
    objConn.Close

'
'    '释放对象
    Set objRec = Nothing
    Set objConn = Nothing


   Else

     MsgBox "没有数据,请重新选择时间段"
     Exit Sub
    End If



'''''''''''''''''''''''''''''''''''''''
''''方法二:速度比方法一快,且自带标题(WPS下有效,但EXCEL下报错)
''
''     执行查询并将结果存储在记录集对象中
''    '连接数据库并执行SQL语句
''    objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"
''
''    objConn.Open
''    objRec.Open sqlstr, objConn
''
''    If Not objRec.EOF Then
''
''     设置工作表对象
''    Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改为你要写入数据的工作表名称
''     将数据写入工作表
''    With WS.QueryTables.Add(Connection:=objRec, Destination:=WS.Range("A1"))
''''        .TextFileParseType = xlFixedWidth '指示将文件中的数据排列在固定宽度的列中'xlDelimited 默认值。 指示文件由分隔符分隔
''''        .TextFileCommaDelimiter = True ' 根据需要更改分隔符,这里使用逗号作为分隔符
''''        .Refresh BackgroundQuery:=False  ' 或使用 .Execute,然后在下一行添加总计行(如果有)并刷新查询表格以获取数据。
''        .Refresh
''    End With
''''使用方法一或方法二时解除注释
'''    关闭记录集和连接
''    objRec.Close
''    objConn.Close
''
'''
''    '释放对象
''    Set objRec = Nothing
''    Set objConn = Nothing
'
'
''   Else
''
''     MsgBox "没有数据,请重新选择时间段"
''     Exit Sub
''    End If


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'
''''方法三:此方法在WPS下报错,但在EXCEL中能执行成功
''  ActiveWorkbook.Queries(1).Delete
''    ActiveWorkbook.Queries.Add Name:="查询1", Formula:= _
''        "let" & Chr(13) & "" & Chr(10) & "    源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)," _
''        & Chr(13) & "" & Chr(10) & "    重命名的列 = Table.RenameColumns(源,{{""FName"", ""FName.1""}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    重命名的列" & ""
'
'    ActiveWorkbook.Queries.Add Name:="查询1", Formula:= _
'        "let" & Chr(13) & "" & Chr(10) & "    源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    源" & ""
'
'
'   ''     设置工作表对象
'    Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改为你要写入数据的工作表名称
'    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
'        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=查询1;Extended Properties=""""" _
'        , Destination:=WS.Range("$A$1")).QueryTable
'        .CommandType = xlCmdSql
'        .CommandText = Array("SELECT * FROM [查询1]")
'        .RowNumbers = False
''        .FillAdjacentFormulas = False
''        .PreserveFormatting = True
''        .RefreshOnFileOpen = False
''        .BackgroundQuery = True
''        .RefreshStyle = xlInsertDeleteCells
''        .SavePassword = False
''        .SaveData = True
''        .AdjustColumnWidth = True
''        .RefreshPeriod = 0
''        .PreserveColumnInfo = False
''        .ListObject.DisplayName = "查询1"
'        .Refresh BackgroundQuery:=True '后台进行查询,false时会跳出对话框
'    End With
''    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
'   ActiveWorkbook.Queries(1).Delete '删除查询

''''''''''''''''''''''''''''''''


    
   moformat.format
Application.ScreenUpdating = True
Application.DisplayAlerts = True
   
    Sheets("目录").Select

 End Sub

查询出的结果 ,有任务的相关信息和所用的工序和工时
在这里插入图片描述

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.mfbz.cn/a/777318.html

如若内容造成侵权/违法违规/事实不符,请联系我们进行投诉反馈qq邮箱809451989@qq.com,一经查实,立即删除!

相关文章

破解在制品管理不透明难题

在快节奏的现代工业浪潮中&#xff0c;每一个细微的管理环节都直接关系到企业的竞争力与盈利能力。在车间生产中&#xff0c;在制品管理流程不透明是一个常见问题&#xff0c;它可能导致生产效率低下、成本增加、库存积压以及沟通障碍等负面影响。 在制品管理流程不透明&#x…

ETAS工具导入Com Arxml修改步骤

文章目录 前言Confgen之前的更改Confgen之后的修改CANCanIfComComMEcuM修改CanNmCanSMDCMCanTp生成RTE过程报错修改DEXT-诊断文件修改Extract问题总结前言 通讯协议栈开发一般通过导入DBC实现,ETAS工具本身导入DBC也是生成arxml后执行cfggen,本文介绍直接导入客户提供的arxml…

8种数据迁移工具

前言 最近有些小伙伴问我&#xff0c;ETL数据迁移工具该用哪些。 ETL(是Extract-Transform-Load的缩写&#xff0c;即数据抽取、转换、装载的过程)&#xff0c;对于企业应用来说&#xff0c;我们经常会遇到各种数据的处理、转换、迁移的场景。 今天特地给大家汇总了一些目前…

迭代加深——AcWing 170. 加成序列

迭代加深 定义 迭代加深搜索&#xff08;Iterative Deepening Depth-First Search, IDS&#xff09;是一种结合了深度优先搜索&#xff08;DFS&#xff09;和广度优先搜索&#xff08;BFS&#xff09;特点的算法。它通过限制搜索树的深度来控制搜索范围&#xff0c;起初以较小…

CTFShow的RE题(一)

RE2 1.中文字符的显示 2.对文件的读取操作 3.RC4加密 &#xff08;有一点是魔改的&#xff09; 4.enflag.txt文件里面的密文是ASCII编码之后的数据(可以放ida中) 也可以放到 010 里&#xff08;推荐&#xff09; encDH~mqqvqxB^||zllJq~jkwpmvez{ key for i in enc:keychr…

程序员下班为什么不关电脑?难道在偷偷加班?!

不管是周围的程序员朋友还是网上的很多程序员朋友&#xff0c;在下班后都是习惯不关电脑的&#xff0c;关上显示器&#xff0c;拿上手机&#xff0c;快乐下班&#xff01; 那么&#xff0c;为什么程序员下班都不关电脑&#xff1f;难道他们在偷偷加班&#xff1f; 其实&#x…

elasticsearch源码分析-04集群状态发布

集群状态发布 cluster模块封装了在集群层面执行的任务&#xff0c;如集群健康、集群级元信息管理、分片分配给节点、节点管理等。集群任务执行之后可能会产生新的集群状态&#xff0c;如果产生新的集群状态主节点会将集群状态广播给其他节点。 集群状态封装在clusterState中&…

基于Qt实现的PDF阅读、编辑工具

记录一下实现pdf工具功能 语言&#xff1a;c、qt IDE&#xff1a;vs2017 环境&#xff1a;win10 一、功能演示&#xff1a; 二、功能介绍&#xff1a; 1.基于saribbon主体界面框架&#xff0c;该框架主要是为了实现类似word导航项 2.加载PDF放大缩小以及预览功能 3.pdf页面跳转…

Qt 网络编程 网络信息获取操作

学习目标&#xff1a;网络信息获取操作 前置环境 运行环境:qt creator 4.12 学习内容 一、Qt 网络编程基础 Qt 直接提供了网络编程模块,包括基于 TCP/IP 的客户端和服务器相关类,如 QTcpSocket/QTcpServer 和 QUdpSocket,以及实现 HTTP、FTP 等协议的高级类,如 QNetworkRe…

SPIN-Diffusion:自我博弈微调提升文本到图像扩散模型性能

扩散模型作为生成AI的关键实体&#xff0c;已经在多个领域展现出了卓越的能力。然而&#xff0c;现有的扩散模型&#xff0c;如Stable Diffusion和SDXL&#xff0c;通常在预训练阶段后需要进行微调以更好地符合人类偏好。最近&#xff0c;研究者们开始尝试使用强化学习&#xf…

矩阵键盘与密码锁

目录 1.矩阵键盘介绍​编辑 2.扫描的概念 3.代码演示&#xff08;读取矩阵键盘键码&#xff09; 4.矩阵键盘密码锁 1.矩阵键盘介绍 为了减少I/O口的占用&#xff0c;通常将按键排列成矩阵形式&#xff0c;采用逐行或逐列的 “扫描”&#xff0c;就可以读出任何位置按键的状态…

jenkins配置gitee源码地址连接不上

报错信息如下&#xff1a; 网上找了好多都没说具体原因&#xff0c;最后还是看jenkins控制台输出日志发现&#xff1a; ssh命令执行失败&#xff08;git环境有问题&#xff0c;可能插件没安装成功等其他问题&#xff09; 后面发现是jenkins配置git的地方git安装路径错了。新手…

帕金森病患者在选择运动疗法时应该注意哪些事项?

帕金森病患者在选择运动疗法时&#xff0c;应该遵循以下几点注意事项&#xff1a; 个性化运动处方&#xff1a;根据患者的病情、年龄、健康状况、以往运动能力等因素&#xff0c;制定个体化的运动处方。 避免运动负荷过大&#xff1a;运动时间不宜过长&#xff0c;注意控制心率…

机器学习 C++ 的opencv实现SVM图像二分类的测试 (三)【附源码】

机器学习 C 的opencv实现SVM图像二分类的测试 (三) 数据集合下载地址&#xff1a;https://download.csdn.net/download/hgaohr1021/89506900 根据上节得到的svm.xml&#xff0c;测试结果为&#xff1a; #include <stdio.h> #include <time.h> #include <o…

智慧生活新篇章,Vatee万腾平台领航前行

在21世纪的科技浪潮中&#xff0c;智慧生活已不再是一个遥远的梦想&#xff0c;而是正逐步成为我们日常生活的现实。从智能家居的温馨便捷&#xff0c;到智慧城市的高效运转&#xff0c;科技的每一次进步都在为我们的生活增添新的色彩。而在这场智慧生活的变革中&#xff0c;Va…

stm32定时器与pwm波

文章目录 4 TIM4.1 SysTick系统定时器4.2 TIM定时器中断与微秒级延时4.3 TIM使用PWM波4.3.1 PWM介绍4.3.2 无源蜂鸣器实现 4.4 TIM ,PWM常用函数 4 TIM 4.1 SysTick系统定时器 ​ Systick系统滴答&#xff0c;&#xff08;同时他有属于自己的中断&#xff0c;可以利用它来做看…

Star CCM+界面显示字体大小调整

前言 打开界面字体显示大小是默认的&#xff0c;软件内设置调整默认字体的大小是无法实现&#xff0c;需要在图标属性中进行设置&#xff0c;操作方法与中英文切换很类似&#xff0c;具体方法如下&#xff1a; 操作流程 1. 右击Star-CCM快捷⽅式&#xff0c;选择“属性”&…

【Mindspore进阶】-03.ShuffleNet实战

ShuffleNet图像分类 当前案例不支持在GPU设备上静态图模式运行&#xff0c;其他模式运行皆支持。 ShuffleNet网络介绍 ShuffleNetV1是旷视科技提出的一种计算高效的CNN模型&#xff0c;和MobileNet, SqueezeNet等一样主要应用在移动端&#xff0c;所以模型的设计目标就是利用有…

lodash-es 基本使用

中文文档&#xff1a;https://www.lodashjs.com/ cloneDeep方法文档&#xff1a;https://www.lodashjs.com/docs/lodash.cloneDeep#_clonedeepvalue 参考掘金文章&#xff1a;https://juejin.cn/post/7354940462061715497 安装&#xff1a; pnpm install lodash-esnpm地址&a…

Ad-hoc命令和模块简介

华子目录 Ad-hoc命令和模块简介1.概念2.格式3.Ansible命令常用参数4.模块类型4.1 三种模块类型4.2Ansible核心模块和附加模块 示例1示例2 Ad-hoc命令和模块简介 1.概念 Ansible提供两种方式去完成任务&#xff0c;一是ad-hoc命令&#xff0c;一是写Ansible playbook(剧本)Ad-…