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

news2024/11/16 16:47:24

经过前期一年多对金蝶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.coloradmin.cn/o/1900957.html

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

相关文章

Java对象比对工具

背景 前段时间的任务中&#xff0c;遇到了需要识别两个对象不同属性的场景&#xff0c;如果使用传统的一个个属性比对equals方法&#xff0c;会存在大量的重复工作&#xff0c;而且为对象新增了属性后&#xff0c;比对方法也需要同步修改&#xff0c;不方便维护&#xff0c;于是…

76 4G模组 境外拨号入网注意

1 引言 最近朋友把国内的设备拿到新加坡了&#xff0c;然后发现原本国内可以使用的设备无法在异国他乡联网&#xff0c;所以就叫我来看看&#xff0c;发现是附网返回状态、入网APN发生了改变导致的。另外&#xff0c;如果在境外使用国产4G模组拨号入网&#xff0c;也需要关注4G…

Nginx实战:nginx性能压测(ab)

在nginx的生产实践中,不管是服务上线,还是性能优化,都会遇到需要对nginx的性能压测,本文介绍一个简单的压测工具:ab命令 ab(Apache Bench)是一个常用的HTTP压力测试工具,可以用来测试Nginx的性能和压力。ab命令可以指定并发请求数、请求数、请求类型等参数,并输出测试…

MySQL第三次作业--DML语句(INSERT)

目录 一、在数据库中创建一个表student&#xff0c;用于存储学生信息 二、向student表中添加一条新记录&#xff0c;记录中id字段的值为1&#xff0c;name字段的值为"monkey"&#xff0c;grade字段的值为98.5 三、向student表中添加多条新记录&#xff1a; 2,&qu…

G1.【C语言】EasyX初步了解

1.介绍 EasyX 是针对 C/C 的图形库&#xff0c;可以帮助使用C/C语言的程序员快速上手图形和游戏编程。 2.安装 EasyX Graphics Library for CEasyX Graphics Library 是针对 Visual C 的绘图库&#xff0c;支持 VC6.0 ~ VC2019&#xff0c;简单易用&#xff0c;学习成本极低…

使用WinSCP工具连接Windows电脑与Ubuntu虚拟机实现文件共享传输

一。环境配置 1.首先你的Windows电脑上安装了VMware虚拟机&#xff0c;虚拟机装有Ubuntu系统&#xff1b; 2.在你的windows电脑安装了WinSCP工具&#xff1b; 3.打开WinSCP工具默认是这样 二。设置WinSCP连接 打开WinSCP&#xff0c;点击新标签页&#xff0c;进入到如下图的…

编码与加密

编码与加密在爬虫中经常涉及&#xff0c;常见的编码有base64, unicode, urlencode&#xff0c;常见的加密有MD5, SHA1, HMAC, DES, AES, RSA。 下面逐一介绍&#xff1a; 一&#xff0c;编码 1.1 常规编码 常规编码约定了字符集中字符与一定长度二进制的映射关系&#xff0…

leetcode刷题(51-60)

算法是码农的基本功&#xff0c;也是各个大厂必考察的重点&#xff0c;让我们一起坚持写题吧。 遇事不决&#xff0c;可问春风&#xff0c;春风不语&#xff0c;即是本心。 我们在我们能力范围内&#xff0c;做好我们该做的事&#xff0c;然后相信一切都事最好的安排就可以啦…

BES 平台 SDK之ANC 参数调整

前言: 最近项目开发进入到DV 阶段,客户临时提了一个需求,希望在ota升级的时候,保留ANC 参数下的total_gain 值,ota只更新滤波器相关参数。total_gain 继续使用产线校准好的值。 一:ANC 参数 1.首先需要找到代码对应ANC 加载的函数: best1502x_ibrt_anc_…

TeXstudio对已加载宏包的命令标记为暗红色未知命令

宏包已正常加载&#xff0c;编译也正常&#xff0c;但却将某些命令标记为暗红色。 具体的原因可参考 https://sourceforge.net/p/texstudio/wiki/Frequently%20Asked%20Questions/#how-does-txs-know-about-valid-commandshttps://sourceforge.net/p/texstudio/wiki/Frequent…

Vue 3集成krpano 全景图展示

Vue 3集成krpano 全景图展示 星光云全景系统源码 VR全景体验地址 星光云全景VR系统 将全景krpano静态资源文件vtour放入vue项目中 导入vue之前需要自己制作一个全景图 需要借助官方工具进行制作 工具下载地址&#xff1a;krpano工具下载地址 注意事项&#xff1a;vuecli…

(软件06)串口屏的应用,让你的产品显得高级一点(下篇)

本文目录 学习前言 单片机代码实现 学习前言 目前市面上我记得好像有IIC的屏幕、SPI的屏幕、并口屏幕、还有就是今天我们介绍的这个串口屏了&#xff0c;串口屏&#xff0c;就是用串口进行通讯的&#xff0c;上篇我们已经介绍了屏幕供应商提供的上位机软件进行配置好了&#…

两年经验前端带你重学前端框架必会的ajax+node.js+webpack+git等技术的个人学习心得、作业及bug记录 Day1

黑马程序员前端AJAX入门到实战全套教程&#xff0c;包含学前端框架必会的&#xff08;ajaxnode.jswebpackgit&#xff09;&#xff0c;一套全覆盖 Day1 你好,我是Qiuner. 为帮助别人少走弯路和记录自己编程学习过程而写博客 这是我的 github https://github.com/Qiuner ⭐️ ​…

前端八股文 对$nextTick的理解

$nexttick是什么? 获取更新后的dom内容 为什么会有$nexttick ? vue的异步更新策略 (这也是vue的优化之一 要不然一修改数据就更新dom 会造成大量的dom更新 浪费性能) 这是因为 message &#xff08;data&#xff09;数据在发现变化的时候&#xff0c;vue 并不会立刻去更…

.mkp勒索病毒:深度解析与防范

引言&#xff1a; 在数字化时代&#xff0c;网络安全问题日益严峻&#xff0c;其中勒索病毒作为一种极具破坏性的恶意软件&#xff0c;严重威胁着个人用户和企业机构的数据安全。在众多勒索病毒家族中&#xff0c;.mkp勒索病毒以其强大的加密能力和广泛的传播方式&#xff0c;成…

54、一维和二维自组织映射(matlab)

1、一维和二维自组织映射原理 一维和二维自组织映射&#xff08;Self-Organizing Maps, SOM&#xff09;是一种无监督的机器学习算法&#xff0c;通过学习输入数据的拓扑结构&#xff0c;将高维输入数据映射到低维的网格结构中&#xff0c;使得相似的输入数据点在映射空间中也…

异步调用 - 初识

目录 1、引入 2、同步调用 2.1、例子&#xff1a;支付功能 2.2、同步调用的好处 2.3、同步调用的缺点 3、异步调用 3.1、异步调用的方式 3.2、异步调用的优势 3.3、异步调用的缺点 3.4、什么场景下使用异步调用 3.5、MQ技术选型 1、引入 为什么想要异步通信呢&…

java 线程同步机制 synchronized

synchronized 代码块 的参数 为对象 且要唯一性 synchronized 修饰方法&#xff1a; 非静态是 当前类的实例 this 静态是当前类 :当前类名.class Cclass.class extends有多实例 不能用this 。 用当前类作为唯一标识 synchronized 优缺点

vue3项目图片压缩+rem+自动重启等plugin使用与打包配置

一、Svg配置 每次引入一张 SVG 图片都需要写一次相对路径&#xff0c;并且对 SVG 图片进行压缩优化也不够方便。 vite-svg-loader插件加载SVG文件作为Vue组件&#xff0c;使用SVGO进行优化。 插件网站https://www.npmjs.com/package/vite-svg-loader 1. 安装 pnpm i vite-svg…

查询数据库下所有表的数据量

个人思路: 首先把库里Schema下表名拿出来放记事本(EmEditor)里, 用一下正则匹配替换 (\w) → select \1 tableName,count(1) from \1 union all 然后把最后的union all删除掉,替换为order by tableName