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;是一种小巧轻便、易于携带和安装的气象观测…
阅读更多...
模拟面试002-Java开发工程师+简历+问题+回答

模拟面试002-Java开发工程师+简历+问题+回答

模拟面试002-Java开发工程师简历问题回答 目录 模拟面试002-Java开发工程师简历问题回答面试简历面试官题问Java基础与编程框架与工具数据库与性能优化项目经验与实践团队合作与沟通 求职者回答Java基础与编程框架与工具数据库与性能优化项目经验与实践团队合作与沟通 参考资料…
阅读更多...
由于找不到xinput1 3.dll无法继续执行重新安装程序

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

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

你要允许此应用对你的设备进行更改吗

在Windows 11中&#xff0c;当你看到提示“你要允许此应用对你的设备进行更改吗&#xff1f;”时&#xff0c;这是系统检测到某个应用或软件试图对你的设备进行更改或安装的提醒。这个提示是为了保护你的系统免受潜在恶意软件的侵害。如果你选择“是”&#xff0c;则应用可以继…
阅读更多...
Elasticsearch 实现 Word、PDF，TXT 文件的全文内容提取与检索

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版

Android增量更新----java版

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

2011年的数字IC设计面经

2011年老罗写的面经&#xff0c;转眼间2024年了&#xff0c;大家凑合着看吧&#xff0c;可以顺便看看2011年的应届生薪资。 本人通信工程硕士&#xff0c;非电子科班出身&#xff0c;主要找数字IC设计的工作&#xff0c;找工作找了一个月左右&#xff0c;还算满意吧&#xff0…
阅读更多...
边缘概率密度、条件概率密度、边缘分布函数、联合分布函数关系

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

目录 二维随机变量及其分布离散型随机变量连续型随机变量边缘分布边缘概率密度举例边缘概率密度 条件概率密度边缘概率密度与条件概率密度的区别边缘概率密度条件概率密度举个具体例子 参考资料 二维随机变量及其分布 离散型随机变量 把所有的概率&#xff0c;都理解成不同质量…
阅读更多...
R迅速切换目录 -R语言002

R迅速切换目录 -R语言002

实用小操作系列 R定位当前目录 getwd() [1] "/data/Rprofile1" #当前工作目录&#xff0c;因为他读取文件都是相对路径&#xff0c;进当前目录&#xff0c;一般不考虑绝对路径&#xff0c;写代码容易乱呀&#xff0c;切目录最简单完善 R切换工作目录 setwd(&q…
阅读更多...
逻辑图框架图等结构图类图的高效制作方式不妨进来看看

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

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

RedHat运维-LinuxSELinux基础4-端口绑定SELinux上下文

1. SELinux将一个_________与一个SELinux上下文相连接&#xff1b; 2. SSH协议将22/tcp端口与__________SELinux上下文相联系&#xff1b; 3. HTTP协议将80/tcp、443/tcp端口与____________SELinux上下文相联系&#xff1b; 4. 列出所有端口的SELinux上下文信息的方法是_______…
阅读更多...
Mongodb索引简介

Mongodb索引简介

学习mongodb&#xff0c;体会mongodb的每一个使用细节&#xff0c;欢迎阅读威赞的文章。这是威赞发布的第84篇mongodb技术文章&#xff0c;欢迎浏览本专栏威赞发布的其他文章。如果您认为我的文章对您有帮助或者解决您的问题&#xff0c;欢迎在文章下面点个赞&#xff0c;或者关…
阅读更多...
Windows密码凭证获取

Windows密码凭证获取

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

常用字符集与乱码原因

1.ASCII字符集&#xff1a;仅对英文字符编码&#xff0c;每个字符用1B编码&#xff0c;7位二进制足以表示所有ASCII字符集&#xff0c;因此最高位始终为0 2.GBK字符集&#xff1a;GB2312字符集&#xff08;简体中文字符集&#xff09;BIG5字符集&#xff08;台湾地区繁体中文字…
阅读更多...
服装购物商城系统小程序-计算机毕业设计源码35058

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

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

Jmeter使用JSON Extractor提取多个变量

1.当正则不好使时&#xff0c;用json extractor 2.提取多个值时&#xff0c;默认值必填&#xff0c;否则读不到变量
阅读更多...
什么是集港‼️货代小白快来点赞收藏-深圳全球利物流有限公司

什么是集港‼️货代小白快来点赞收藏-深圳全球利物流有限公司

集港是什么意思? 集港的定义 集港是指将分散在各处的集装箱集中到港口码头堆场的过程&#xff0c;即把各地的集装箱汇集到港区&#xff0c;准备装船。在船挂靠码头之前&#xff0c;码头会制定集港计划&#xff0c;安排货船的集装箱在某个时间段内进入码头并摆放好&#xff0c;…
阅读更多...
【js】this指向问题

【js】this指向问题

1.首先先明确&#xff0c;this会出现在哪里。 this出现在全局作用域中&#xff0c;或函数作用域中&#xff08;普通函数、箭头函数&#xff09;。 对象是不产生作用域的&#xff0c;对象的{}和函数的{}不一样&#xff0c;this并不会直接出现在对象或类中&#xff0c;只会出现在…
阅读更多...
Android SurfaceFlinger——屏幕状态初始化（二十二）

Android SurfaceFlinger——屏幕状态初始化（二十二）

对于开机启动动画前期准备的相关步骤，我们已经分析了前 5 个，对于第 6 步调用 eglGetDisplay() 函数对 OpenGL ES 初始化并获取默认屏幕，我们在介绍 OpenGL ES 的时候也进行了详细的分析，下一步我们我们来分析对屏幕的状态进行初始化。 1）getInternalDisplayToken：获取显…
阅读更多...
最新文章

Copyright @ 2022~2023