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

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

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

Private Sub CommandButton1_Click()Startview.Show 0CommandButton1.Enabled = FalseActiveSheet.Range("C3") = Now()
End SubPrivate Sub CommandButton2_Click()summary.statisticalCommandButton2.Enabled = FalseActiveSheet.Range("C4") = Now()
End SubPrivate Sub CommandButton3_Click()count.countCommandButton3.Enabled = FalseActiveSheet.Range("C6") = Now()
End SubPrivate Sub CommandButton4_Click()
CommandButton1.Enabled = True
End SubPrivate Sub CommandButton5_Click()
CommandButton2.Enabled = True
End SubPrivate Sub CommandButton6_Click()
CommandButton3.Enabled = True
End SubPrivate Sub CommandButton7_Click()CLWX_JE.getjeCommandButton7.Enabled = FalseActiveSheet.Range("C5") = Now()
End SubPrivate Sub CommandButton8_Click()
CommandButton7.Enabled = True
End Sub

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

“确认”按钮代码如下

  Option ExplicitPublic daymark As Boolean'获取传入月份的最大日期Function maxday(year As Integer, month As Integer) As Integermaxday = Day(DateSerial(year, month + 1, 1) - 1)End Function'确认,获取任务
Private Sub ButtonEnter_Click()gettask.getdateEnd Sub'起始年的CHANGE事件
Private Sub ComboBox1_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox1.AddItem iNextEnd 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.ValueDim i As IntegerMe.ComboBox3.ClearFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNext
End Sub
'起始日的CHANGE事件
Private Sub ComboBox3_Change()
'   当点击日期时,进行选择Dim i As IntegerFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNextEnd 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.ValueIf Me.ComboBox2.Value > 12 Or Me.ComboBox2.Value <= 0 ThenMsgBox "起始月份有错误"End IfIf Me.ComboBox3.Value > maxday(Me.ComboBox1.Value, Me.ComboBox2.Value) Or Me.ComboBox3.Value <= 0 ThenMsgBox "起始日期有错误"End IfEnd Sub
'结束年的CHANGE事件
Private Sub ComboBox4_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox4.AddItem iNextEnd 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 IntegerMe.ComboBox6.ClearFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd Sub'结束日的CHANGE事件
Private Sub ComboBox6_Change()'   当点击日期时,进行选择Dim i As IntegerFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd 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.ValueIf Me.ComboBox5.Value > 12 Or Me.ComboBox5.Value <= 0 ThenMsgBox "结束月份有错误"End IfIf Me.ComboBox6.Value > maxday(Me.ComboBox4.Value, Me.ComboBox5.Value) Or Me.ComboBox6.Value <= 0 ThenMsgBox "结束日期有错误"End IfEnd Sub'界面初始化
Private Sub UserForm_Initialize()
'    daymark = TrueMe.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.ValueMe.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.ValueMe.Sdate.Visible = FalseMe.Edate.Visible = FalseEnd Sub

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

 Sub getdate()Dim sqlstr As StringDim WS As WorksheetDim rng As RangeDim sheetName As StringDim i As Long, MAXRGN As LongDim objRecDim objConnDim Sdate As Variant, Edate As VariantDim response As VbMsgBoxResultApplication.ScreenUpdating = False  '关闭屏幕更新,加快程序运行
Application.DisplayAlerts = False   '不显示警告信息'获取起止时间Sdate = Startview.Sdate.CaptionEdate = Startview.Edate.CaptionIf Sdate <= Edate Thenresponse = MsgBox("查询的日期是:" & Sdate & "至" & Edate & "吗?", vbQuestion + vbYesNo, "确认")If response = vbYes ThenGoTo continueElseExit SubEnd IfElseMsgBox "查询时间段设置有误,请检查"Exit SubEnd If
continue:Unload Startview'''''''''检查工作表是否存在,不存在则新建一个' 设置要检查的工作表名称sheetName = "机加任务及工时"
'    ' 遍历工作簿中的所有工作表,检查是否存在同名工作表For Each WS In ThisWorkbook.SheetsIf WS.Name = sheetName Theni = 1End IfNext'如果没有则新增If i = 0 ThenSet WS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))WS.Name = sheetNameEnd If'清除原有数据ActiveWorkbook.Sheets(sheetName).SelectMAXRGN = Worksheets(sheetName).Range("a" & Rows.count).End(xlUp).RowIf MAXRGN <> 0 ThenSet 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.OpenSet objRec = objConn.Execute(sqlstr)If Not objRec.EOF Then''    '将结果集保存到工作表Set WS = ThisWorkbook.Worksheets(sheetName) ''将标题写入工作表For i = 0 To objRec.Fields.count - 1WS.Cells(1, i + 1).Value = objRec.Fields(i).NameNext iActiveSheet.Range("A2").CopyFromRecordset objRec
''使用方法一或方法二时解除注释
''    关闭记录集和连接objRec.CloseobjConn.Close'
'    '释放对象Set objRec = NothingSet objConn = NothingElseMsgBox "没有数据,请重新选择时间段"Exit SubEnd 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 = TrueSheets("目录").SelectEnd Sub

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

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

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

便携式气象站:探索自然的智慧伙伴

在探索自然奥秘、追求科学真理的道路上&#xff0c;气象数据始终是我们不可或缺的指引。然而&#xff0c;传统的气象站往往庞大而笨重&#xff0c;难以在偏远地区或移动环境中灵活部署。 便携式气象站&#xff0c;顾名思义&#xff0c;是一种小巧轻便、易于携带和安装的气象观测…

由于找不到xinput1 3.dll无法继续执行重新安装程序

如果您的计算机提示无法找到xinput1_3.dll文件&#xff0c;这可能表明您的计算机存在问题。在这种情况下&#xff0c;您需要立即对xinput1_3.dll文件进行修复&#xff0c;否则您的某些程序将无法启动。以下是解决无法找到xinput1_3.dll文件的方法。 一、关于xinput1_3.dll文件的…

Elasticsearch 实现 Word、PDF,TXT 文件的全文内容提取与检索

文章目录 一、安装软件:1.通过docker安装好Es、kibana安装kibana:2.安装原文检索与分词插件:之后我们可以通过doc命令查看下载的镜像以及运行的状态:二、创建管道pipeline名称为attachment二、创建索引映射:用于存放上传文件的信息三、SpringBoot整合对于原文检索1、导入依赖…

安全及应用(更新)

一、账号安全 1.1系统帐号清理 #查看/sbin/nologin结尾的文件并统计 [rootrootlocalhost ~]# grep /sbin/nologin$ /etc/passwd |wc -l 40#查看apache登录的shell [rootrootlocalhost ~]# grep apache /etc/passwd apache:x:48:48:Apache:/usr/share/httpd:/sbin/nologin#改变…

Android增量更新----java版

一、背景 开发过程中&#xff0c;随着apk包越来越大&#xff0c;全量更新会使得耗时&#xff0c;同时浪费流量&#xff0c;为了节省时间&#xff0c;使用增量更新解决。网上很多文章都不是很清楚&#xff0c;没有手把手教学&#xff0c;使得很多初学者&#xff0c;摸不着头脑&a…

边缘概率密度、条件概率密度、边缘分布函数、联合分布函数关系

目录 二维随机变量及其分布离散型随机变量连续型随机变量边缘分布边缘概率密度举例边缘概率密度 条件概率密度边缘概率密度与条件概率密度的区别边缘概率密度条件概率密度举个具体例子 参考资料 二维随机变量及其分布 离散型随机变量 把所有的概率&#xff0c;都理解成不同质量…

逻辑图框架图等结构图类图的高效制作方式不妨进来看看

**逻辑图框架图等结构图类图的高效制作方式不妨进来看看** 基于我们每天都在处理大量的数据和信息。为了更清晰地理解和传达这些信息&#xff0c;结构图、逻辑图和框架图等可视化工具变得越来越重要。然而&#xff0c;如何高效地制作这些图表并确保其准确性和易读性呢&#xf…

Windows密码凭证获取

Windows HASH HASH简介 hash &#xff0c;一般翻译做散列&#xff0c;或音译为哈希&#xff0c;所谓哈希&#xff0c;就是使用一种加密函数进行计算后的结果。这个 加密函数对一个任意长度的字符串数据进行一次数学加密函数运算&#xff0c;然后返回一个固定长度的字符串。…

服装购物商城系统小程序-计算机毕业设计源码35058

摘要 服装购物商城系统小程序&#xff0c;依托Spring Boot框架的强大支持&#xff0c;为用户呈现了一个功能丰富、体验流畅的在线购物平台。该系统不仅涵盖了商品展示、用户注册登录、购物车管理、订单处理、支付集成等核心购物流程&#xff0c;还引入了个性化推荐算法&#xf…

Jmeter使用JSON Extractor提取多个变量

1.当正则不好使时&#xff0c;用json extractor 2.提取多个值时&#xff0c;默认值必填&#xff0c;否则读不到变量

Java | Leetcode Java题解之第212题单词搜索II

题目&#xff1a; 题解&#xff1a; class Solution {int[][] dirs {{1, 0}, {-1, 0}, {0, 1}, {0, -1}};public List<String> findWords(char[][] board, String[] words) {Trie trie new Trie();for (String word : words) {trie.insert(word);}Set<String> a…

VitePress美化

参考资料&#xff1a; https://blog.csdn.net/weixin_44803753/article/details/130903396 https://blog.csdn.net/qq_30678861/category_12467776.html 站点信息修改 首页部分的修改基本都在.vitepress/config.mts,这个文件内修改。 title 站点名称 description 描述 top…

Java springboot校园管理系统源码

Java springboot校园管理系统源码-014 下载地址&#xff1a;https://download.csdn.net/download/xiaohua1992/89364089 技术栈 运行环境&#xff1a;jdk8 tomcat9 mysql5.7 windows10 服务端技术&#xff1a;Spring Boot Mybatis VUE 使用说明 1.使用Navicati或者其它工…

Midjourney 如何使用参考图像来提升图像的准确性和相似度?

🧙🏼图像提示 🧙🏼‍♂️ 您可以使用图像作为提示的一部分来影响作业的构图、样式和颜色。图像提示可以单独使用,也可以与文本提示一起使用 - 尝试组合具有不同样式的图像以获得最令人兴奋的结果。 🛠️实际图像提示操作步骤 点击加号按钮,双击上传文件,把小黄猫…

ePTFE膜(膨体聚四氟乙烯膜)应用前景广阔 本土企业技术水平不断提升

ePTFE膜&#xff08;膨体聚四氟乙烯膜&#xff09;应用前景广阔 本土企业技术水平不断提升 ePTFE膜全称为膨体聚四氟乙烯膜&#xff0c;指以膨体聚四氟乙烯&#xff08;ePTFE&#xff09;为原材料制成的薄膜。ePTFE膜具有耐化学腐蚀、防水透气性好、耐候性佳、耐磨、抗撕裂等优…

Web美食分享平台的系统-计算机毕业设计源码45429

基于Web美食分享平台的系统设计与实现 摘 要 本研究基于Spring Boot框架&#xff0c;设计并实现了一个Web美食分享平台&#xff0c;旨在为用户提供一个交流分享美食体验的社区平台。该平台涵盖了用户注册登录、美食制作方法分享发布、点赞评论互动等功能模块&#xff0c;致力于…

3D Web轻量化平台HOOPS Web Platform的功能与应用分析

随着3D技术在多个行业的广泛应用&#xff0c;对于3D模型轻量化的需求日益增长。HOOPS Web Platform作为一个先进的3D模型轻量化平台&#xff0c;为开发人员提供了一整套工具来构建和部署基于Web的工程应用程序。本文将分析HOOPS Web Platform的核心功能和它在不同领域的应用情况…

软件工程学面向对象

一、面向对象方法学概述 传统的生命周期方法学在消除软件非结构化、促进软件开发工程化方面起了积极的作用&#xff0c;但仍有许多不足&#xff0c;存在的主要问题有&#xff1a;①生产率提高的幅度不能满足需要&#xff1b; ②软件重用程度很低&#xff1b; ③软件很难维护&a…

硬件开发工具Arduino IDE

招聘信息共享社群 关联上篇文章乐鑫ESPRESSIF芯片开发简介 Arduino IDE&#xff08;集成开发环境&#xff09;是为Arduino硬件开发而设计的一款软件&#xff0c;它提供了一个易于使用的图形界面&#xff0c;允许用户编写、编辑、编译和上传代码到Arduino开发板。Arduino IDE的…

深入分析 Android BroadcastReceiver (八)

文章目录 深入分析 Android BroadcastReceiver (八)1. 系统与自定义实现1.1 系统广播机制1.1.1 系统广播的实现原理1.1.2 系统广播的源码分析 1.2 自定义广播机制1.2.1 自定义广播的实现步骤1.2.2 自定义广播的源码分析 2. 广播机制设计的初衷与优势2.1 设计初衷2.2 优势 3. 总…