车间计件生产日报

丝竹乱

表格设计的初衷，是为了方便车间统计各个操作员员得产量。
报表的数据处理流程，是
A  读取资料
1）读取  派工单（计划表）
2）读取 工艺清单
3）读取 人员名单
4）读取 作息时间

B 界面输入信息
1）生产班次、工作开始和结束时间
2）人员名单、班组信息
3）工单编号
……

C 在输入过程中触发事件，从读取的资料中输出相关信息

D  提交报表


表格中代码的解说、以及设计思路，在评论区逐一说明。
由于学习不够深入、水平有限，不足的地方请大家不吝指出。

丝竹乱

1 输入界面简述

A 主输入区的样式


输入界面的左侧标题，和生产报表的标题一致，这样设置简化了数据提交过程的代码编写

B 辅助输入区的格式
由于班组人数在30左右，所以另外设置了人员名单区域。为方便处理人员名单，加入了双击鼠标事件，在双击工号时能删除相应的个人信息。
（注意，计件报表要求具体记录清楚每个人的产量，所以要这样设置）



C 这部分的代码 ：
1) 充分利用事件的激活或静默处理，让代码连续运行（类似于递归），完成对不同数据的输出



    ElseIf Not Application.Intersect(Target, Range("G17")) Is Nothing Then          '物料激活
        Application.EnableEvents = False
……
        If rk > UBound(aryMO, 1) Then
            MsgBoxEx 0, "生产工单内无产品资料，Excel退出运行。", "1.5秒后自动关闭", vbCritical, 1, 1500
'            Target = "——"
            Application.EnableEvents = True
            Exit Sub
        Else
            Application.EnableEvents = True     《== 事件激活的目的，是让目标区域写入产品型号时候，再次激活事件
            Target.Offset(1, 0) = strCodeModel          '产品型号   
        End If



2）激活操作界面，重新读取一次数据


Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
'    SCANflag = 1
    booLoadData = False     《== 强制其它过程的代码在运行前重新读取一次其它支持表格的数据。避免因为修改支持数据没有更新
    Sheets("【操作界面】").Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, Password:="GaiShan"
    Sheets("【操作界面】").Select
    Application.ScreenUpdating = True
End Sub

丝竹乱

2 公司内网的间的数据抓取
在公司内，生产工单、工艺清单、人员名单可能分属不同职能部门或人员维护。为确保所使用的资料是最新，往往耗费大量的时间和人力去处理。
在本工作簿中，尝试用另外一种方式来处理这种事情。



将局域网内的文件路径、文件名、表格名用工作表“【更新设置】”保存。使用者只需要修改相应的内容就行。
这段代码可略作修改就可以移植到其它工作簿中。

处理流程：  
读取“【更新设置】”  ==》打开指定路径工作簿==》读取相应的工作表，建立数组==》粘贴到本地工作簿。
（注意，读取数组的过程中，加入了删除源数据错误信息的步骤，这样可以减少程序报错）


Public Sub 联网更新()
    '2021-02-19
    Dim ExcelAPP As Object
    Dim ExcelWB As Object
    Dim FSO As Object
    Dim aryList(), aryINFO(), aryTempSH, arySoSH
    Dim FileSpec$, rj%, iSH%
    Dim booErrFile As Boolean
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    With ThisWorkbook
        .Unprotect Password:="1024"
    End With
    aryINFO = CreatingArrayFromRange(1, 1, "【更新设置】")
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For rj = 2 To UBound(aryINFO)
        aryINFO(rj, 8) = Empty
        If aryINFO(rj, 1) = "数据更新" Then
            If IsEmpty(aryINFO(rj, 2)) Then
                FileSpec = ThisWorkbook.Path & "\" & aryINFO(rj, 3)
            Else
                FileSpec = aryINFO(rj, 2) & "\" & aryINFO(rj, 3)
            End If
            If FSO.FileExists(FileSpec) Then
                If aryINFO(rj, 6) <> FSO.GetFile(FileSpec).DateLastModified Or aryINFO(rj, 8) <> "完成" Then
                    aryINFO(rj, 6) = FSO.GetFile(FileSpec).DateLastModified
                    Set ExcelWB = GetObject(FileSpec)
                    Set ExcelAPP = ExcelWB.Application                          '打开指定文件
                    aryTempSH = Split(aryINFO(rj, 5), "/")
                    arySoSH = Split(aryINFO(rj, 4), "/")
                    For iSH = LBound(aryTempSH) To UBound(aryTempSH)
                        If SheetIsExist(CStr(aryTempSH(iSH))) = False Then      '本地工作表为假则新建
                            ThisWorkbook.Sheets.Add.Name = aryTempSH(iSH)
                        End If

                        If SheetIsExist(CStr(arySoSH(iSH)), ExcelWB.Name) Then  '源工作表为假则报错
                            With ExcelWB.Worksheets(arySoSH(iSH))
                                aryList = CreatingArrayFromRange(1, 1, CStr(arySoSH(iSH)), , , ExcelWB.Name)    '读取数据

                                With ThisWorkbook.Worksheets(aryTempSH(iSH))    '将数据贴入本地工作表
                                    .Unprotect Password:="GaiShan"
                                    .Cells.Clear
                                    .[a1].Resize(UBound(aryList, 1), UBound(aryList, 2)) = aryList
                                    .Cells.EntireColumn.AutoFit
                                    .Cells.EntireRow.AutoFit
                                    .Visible = False
                                End With

                                aryINFO(rj, 7) = Now
                                aryINFO(rj, 8) = "完成"
                                Erase aryList
                            End With
                        Else
                            aryINFO(rj, 8) = "源文件中工作表不存在或名称出错" & Chr(10) & aryINFO(rj, 8)
'                                MsgBox _
'                                    "错误代码：" & Err.Number & Chr(10) & _
'                                    "错误说明：" & Err.Description & Chr(10) & _
'                                    "工作簿路径：" & FileSpec & Chr(10) & _
'                                    "工作表名称：《" & arySoSH(iSH) & "》" & Chr(10) & "不存在或名称不符"
                        End If
                    Next iSH
                    ExcelWB.Close False '关闭工作簿
                    Set ExcelAPP = Nothing
                End If
               
            ElseIf aryINFO(rj, 1) = "数据更新" Then
                aryINFO(rj, 8) = "源文件路径出错或文件不存在" & Chr(10) & aryINFO(rj, 8)
                If Not booErrFile Then
                    MsgBox _
                        "错误代码：" & Err.Number & Chr(10) & _
                        "错误说明：" & Err.Description & Chr(10) & _
                        "工作簿路径：" & FileSpec & Chr(10) & _
                        "工作簿名称：《" & aryINFO(rj, 3) & "》" & Chr(10) & "不存在或名称不符" & _
                        Chr(10) & " 细节请查阅工作表“【更新设置】”。"
                    booErrFile = True
                End If
            End If
        End If
    Next rj
    Set FSO = Nothing
   
    With ThisWorkbook
        .Worksheets("【更新设置】").Range("A1").Resize(UBound(aryINFO, 1), UBound(aryINFO, 2)) = aryINFO
        .Save
    End With
    Application.EnableEvents = True
End Sub

丝竹乱

来一张动图，

丝竹乱

如何处理表格格式变化的问题。
这是个令人头疼的事情，因为实际使用中，表格结构要不被人无意修改、要不出现不得不修改的情况。标题也可能在不同情况下被修改。
也许，能熟练使用SQL可以很好的解决这个问题。

本文件，尝试用另外一种方法来处理这种情况。这样做，直接的好处就是使用者可以随意的移动数据表的列。标题在需要修改的时候，也只要在工作簿内全部单元格内容替换。

操作的方法：
1）将关键标题逐个设置全局变量
2）将内置的全局变量（工作表“标题设置”中的英文标题）和可能会发生修改的标题（相关工作表内的中文标题）外置在一张工作表。
3）在程序运行前，都必须读取【标题设置】这张工作表的内容，确定相应表格的标题所在列。

说实话，为了想到这种办法，我是绞尽脑汁了。 代码也有点绕，自己在阅读的时候都容易犯迷糊。
希望有人能提供一些建议、方法。我觉得这个部分不够好，代码很冗长，繁琐。
（注，为了防止出错，我另外在表格内建立了“标题”工作表，用函数来编写一些语句。）

代码就不贴了，都在“全局模块”中。

faruxue1

大佬厉害，一定好好学习下

丝竹乱

faruxue1 发表于 2022-5-15 22:18
大佬厉害，一定好好学习下

有时间帮我瞄瞄，指点指点哈！

mingbing1234

收藏中！谢谢楼主的分享，支持一下！