应用ExcelVBA解决日常工作的实现过程

楔子

近日,有个朋友跟我聊起他工作上的烦恼。

他:“你知道,我有个钢材店铺,生意大小不说,有个工作特别麻烦,请的员工都不愿意做,现在是我老婆在做,做时间长了她都不想做了。你不是做软件的吗,你看能不能帮我想想办法?”

他做钢材我一直是知道的,也知道他做的业务也不算小,跟他还算是熟悉,但仅限于日常生活,之前工作上聊的并不多,也很少向我寻求帮助,现在他问起我这个问题,我相信他确实是遇到了困难。

不过,还是想逗下他:“你们这店铺的业务我还真没了解过,我不知道能帮你什么忙。而且你也知道,我的出场费不低还得按天计的哦,当然相对于你的业务是九牛一毛了。”

他锤了我一拳:“你这臭小子,谈起钱来是六亲不认啊。这样好了,你帮我解决问题后,你跟我到我老家荔枝园去,随便你摘,如何?”

看来他是认真了,我说:“谈钱不伤感情,嘿嘿。那就先说好哈,如果能帮上你的话,那就照你说的,到时找部车去你家荔枝园拉去;而我也不保证能帮到你哈,如帮不上忙我就不找车,人去就好了。”

他开心的大笑:“我知道你肯定行的。你看,这是客户也就是那些工头给我们下的单,这些工头普遍文化水平不高,单据很不规范。”

他把照片发到我微信上,就是如下那些图片。我看了下,虽然字写得不算好看,但还是能看出来写的是什么,当然表达的啥意思我也没懂,也更看不出哪不规范。

“你给我讲下这单给到你们后你们要做什么,还有咋样的是规范的呢?”我问。

他又给我看了另一张照片:“你看,这是一个有点文化的工头单,像这样的就挺好。”

他把图片又发了给我,然后再把他的情况说了下:

  1. 拿到单之后,要安排工人找到相应规格(也就是直径)的钢材,然后按下料尺寸裁剪好,同时如果有图片上画的那些形状,那就是要照着折弯,有弯1边的,弯2边的,还有弯3边甚至4边的,普遍是弯2边的,2边以上的少。最后还得算出重量,这样工人能知道这个月能拿多少钱。
  2. 因此相同的规格要放在一起,毕竟相同的规格其每米重量相对来说是固定的,这样再加上长度,还有数量,那就容易算出重量了。

毕竟跟财务打交道久了,从这看来他们是按业务量来计算的,多劳多得,这就能有效激发工人积极性,看来隔行如隔山这句老话没错,销售钢材这种看起来简单的业务,从销售流程到管理等等都还是有自己的门道的。一说到钱我又来劲了:“要算这么准呢,那工人工资是如何算的。”

他瞟了我一眼:“你以为呢,他们做的都是力气活,怎么算我就不说了,一般一个工人一个月下来2万上下。”

哇哟,他那可是三四线城市呢,比起我们一般的SAP顾问来也不低啊,看来不能小看搬砖的了。“这工资不低啊,要不我去给你搬铁行了。”

他看了看我:“你这身板,还是算了吧,一天你都坚持不来。唉唉,说到哪去了,说正事呢,我这忙你可要帮啊,你嫂子做这个每天都得花2个小时,如果不解决,你嫂子都要闹离婚了。”

我有点困惑了:“你想要我做什么呢?”

“你帮我想个办法啊,把工头发来的那些不规范的单据或图片,做成规范的样子。最好是在手机或电脑上,点击一下就变过来的。先前都是一条一条记录抄到另一张纸上然后计算器计算的,哟,这是我们之前做出来的效果。”

聊到这里,基本上清除他的问题和提出的需求了。

  • 问题:客户单据不规范,他们拿到单后,要按规格对数据进行分类整理还有之后重量的计算等,这样浪费了很多时间,而且容易错漏。
  • 提出的需求:能将图片上不规范的内容,一键转换成按规格分类的规范的数据,且最好能计算出重量。

了解到这些后,我脑子一闪想到的方案是:OCR文字识别,通过OCR识别到文字后,然后放到Excel中去处理。不过接触OCR也是几年前了,那时是用OCR识别一些文档上的内容以减少文字录入工作以提高项目方案的编写,效果还是不错的,现在有了更多的产品包括有云计算等,识别率应该更高,不过那些都是印刷文档,像这些手写体的识别还得打个问号。

“你容我几天想想,到时我想好办法了告诉你。还有,记得荔枝的事”,我说。

“少不了你的啦。这事也不着急,啥时好了通知我下。”

然后就是天南海北胡侃略过不提。

后来,我花了一个晚上的时间,在网上找了各种OCR的软件,有传统的OCR如汉王、清华和在线转换的、淘宝淘的,以及新的基于云计算的阿里、百度等,这些软件或云产品,如果是印刷文档不管是扫描的还是拍照的,识别率都还是不错,而用朋友发我的图片去试,基本识别不到几个。

“这忙没法帮啊”,我拿起电话打算告诉朋友,看了看时间有11点多了,那就明天再说吧。

第二天上班,忙过工作上的事情后,想到朋友这个事情,想着如果告诉他没办法他该是多么失望,看着电脑上打开的Excel,冒出了个念头:“这样的图片,识别率再高还是不可能达到100%,何况现在的情况是20%都达不到;如果换个方向,不是考虑如何识别数字,而是考虑数据手工录入,然后用Excel快速处理,是否更合理?”

我拿起手机拨了朋友的电话:“把图片给你转换过来后,你们还要计算重量的吧,我看到你那规范的图片上也没重量啊,那你们怎么算重量呢?”

他想了想,说:“如果我们有了那规范的内容,那算重量就很简单了,当然下料长度我们有的要考虑余量得调整下,规格长度数量都有了就敲计算器,噼里啪啦20多分钟一张单就计算出来了,因此这个重量也不是特重要,当然你那转换后能算出来就更好了。”

“你咋不瞟一眼取款机就给你吐钱呢。行,我再好好想想哈”,说完就挂了。

然后我根据了解的情况,重新整了下思路:

  1. 数据采集不是重点,采集后的数据处理才是;
  2. OCR识别后的数据,人工检查比对和整理更耗时,因此不考虑OCR;
  3. 设计格式对照单据人工录入Excel,如此可便于对比;录入完成后通过Excel的二次开发实现数据分类和计算,只要逻辑正确,数据没录错结果就是对的。

接下来就是需求的详细分析和实现的具体设计了。

需求及实现

1、需求分析过程

1】输出结果样板设计

根据朋友所说的要的那种规范图片效果,以及要计算重量的需求,我先用Excel设计出来一个输出结果样稿,如图所示,其中包含3部分:

  • 抬头:店铺名称、客户、下单日期、送货日期、页码,如此方便订单跟踪和装订;

  • 数据:规格、客户下料长度、实际长度、图示、数量、重量、备注,如此把客户下单和计算结果和备注的信息都可以记录;其中一个单中相同规格在一起,且只保留第一个单元格就好方便查看;下料长度则是店铺根据其客户下料长度及加工余量调整后的实际长度,计算重量需要用此长度;数量按客户单据数值;重量则用规格、实际长度、数量按公式计算;图示是给工人加工时参考的是非常有帮助的信息,在经过详细测试,通过制表符号以及文字下标格式能很好的体现不弯、弯1边和弯2边的情况,如超过2边弯的,不多,那么图示留空打印后再人工画上去;备注栏则可用于备注信息包括超2边弯的及其他补充事项,还可以留着打印出来后写上其他内容如加工完成或运送登记等。

  • 尾注:留空,用于手工填写整个工单的补充说明,或是之后交接等内容。

设计完成后的结果如图示,输出格式为横向A4纸。

2】数据录入样式及规范

输出结果那里是经过分类整理的,与原有客户单据顺序已不同,且按样板格式要求录入那简直是累人,因此不能让操作者在输出结果那录入,而是专门有一个方便数据录入的表,可以照着单据逐条快速录入。同时考虑数据的跟踪,在“数据录入”工作表中增加一栏“客户下料”以记录客户下单时所需的长度,用“实际下料”作为之后统计用的长度。

根据输出结果中所需的数据,录入的记录表设计如图,同时对操作进行了规范。

并在此界面放了个按钮,数据录入完成后点击此按钮,将自动按输出结果样板的效果,一键转换输出,这则是本实现重点,见下一节。

数据录入样式
录入规范

3】开发实现分析

开发的目的,是将数据录入表中输入的数据,按输出结果样板进行输出。

要完成此目的,规划的算法如下。

1)复制录入数据到数据处理表并进行排序、计算、分组等处理

将“数据录入”表中的数据复制到命名为“数据处理”的新工作表中,这样可以保留原始录入数据以方便核对;

然后在“数据处理”工作表对数据进行排序、重量计算、分组等处理,以做好最后的输出准备;

2)建立输出结果表并将处理后的数据添加到输出页面中

用一名为“输出模板”的工作表存储输出结果的样板,在最终结果输出前根据数据处理后的行数(包括汇总行),确定输出页数后,新建一名为“输出结果”的工作表,并按输出页数复制出相应数量的输出模板到“输出结果”工作表,并设置好打印区域;

最后将“数据处理”工作表中的数据,逐条写入到“输出结果”的页面中,由此得到所需的打印结果;

3)打印设置及后处理

对输出结果进行打印设置,包括设置为窄页边距、横向、置中等;

最后将产生的工作表“数据处理”删除,还有将工作表“输出结果”移动到新的工作簿中保存,如此保持数据输入后及转换前的文件,如此得到需要打印的结果。

2、具体实现

在录入数据的工作表“数据录入”和用于打印输出格式的“输出模板”设计好后,具体的实现工作则是根据开发实现分析的思路通过VBA来完成,新建一模板后各部分代码列出如下。

1】全局变量及主程序

Dim Sh_cal As Worksheet      '数据处理的工作表
Dim Sh_res As Worksheet      '输出结果的工作表
Dim wb_name                  '当前工作簿的名称
Dim wb_path                  '当前工作簿所在路径
Dim Rec_rows As Integer      '包括页眉的记录行数
Dim Rec_typeRows As Integer  '不包括页眉的记录数量
Dim Rec_groupN As Integer    '规格数量
Dim Page_number As Integer   '输出页数
Dim Page_rows As Integer     '每页能容纳行数

Sub PrintSheet()
'********************
'     总处理过程
'********************
    '********获得记录********
    Sheets("数据录入").Select
    Range("A1").Select
    Rec_rows = Range("B65536").End(3).Row  '包含内容行数
    Rec_typeRows = Rec_rows - 4            '记录行数
    If Rec_typeRows <= 0 Then
       MsgBox "请输入数据后再点击整理"
       Exit Sub
    End If

    wb_path = ThisWorkbook.Path
    wb_name = ThisWorkbook.Name
    Page_rows = 15
    
    Application.ScreenUpdating = False
    '********删除多余表********
    Application.DisplayAlerts = False
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name = "打印结果" Or Sheets(i).Name = "数据处理" Then
            Sheets(i).Delete
        End If
    Next i
    
    Call Add_CalData
    Call Add_PrintData
    Call Print_set
    Call Move_data
    Application.ScreenUpdating = True

End Sub

2】数据处理

Sub Add_CalData()
'********************
'     数据处理
'********************

    '********复制数据录入内容********
    Sheets("数据录入").Select
    Range("A1:J" & Rec_rows).Select   '复制数据
    Selection.Copy

   '********新建数据处理表********
    Set Sh_cal = Worksheets.Add(After:=Sheets("打印模板"))
    Sh_cal.Name = "数据处理"
    Sh_cal.Select

    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste

    Cells(4, 11) = "重量"
    Cells(4, 12) = "符号"
    For i = 5 To Rec_rows
        '填写实际长度
        If Cells(i, 5) = "" And Cells(i, 3) <> "" Then
           Cells(i, 5) = Cells(i, 3)
        End If
    Next i

    '排序数据
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B5:B" & Rec_rows), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("E5:E" & Rec_rows), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A5:J" & Rec_rows)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    '插入空行和处理备注
    Rec_groupN = 0
    For i = Rec_rows To 5 Step -1
        prv_value = Cells(i + 1, 2).Value
        next_value = Cells(i, 2).Value
        Cells(i, 12) = "φ"
        If Cells(i, 10) = "" And Cells(i, 9) <> "" Then
           Cells(i, 10) = "多边弯"     '如果备注非空且“其他形状”含值,则设置备注为“多边折弯”
        End If

        If next_value <> prv_value Then
            Rows(i + 1).Insert shift:=xlDown
            Cells(i + 1, 5).Value = "合计"
            Rec_groupN = Rec_groupN + 1
        End If
    Next i

    '插入行后记录数量
    Rec_rows = Rec_rows + Rec_groupN
    Rec_typeRows = Rec_typeRows + Rec_groupN
    '页数
    Page_number = CInt(Rec_typeRows / (Page_rows * 2) + 0.5)
       

    '重量数量合计值更新
    sum_weight = 0
    sum_qty = 0
    For i = 5 To Rec_rows
        '计算重量数量和填写合计值
        If Cells(i, 5) <> "合计" Then
            Cells(i, 11) = Cells(i, 2) * Cells(i, 2) * 0.00617 * Cells(i, 5) * Cells(i, 4) '计算重量
            sum_weight = sum_weight + Cells(i, 11)
            sum_qty = sum_qty + Cells(i, 4)
         Else
            Cells(i, 11).Value = sum_weight
            Cells(i, 4).Value = sum_qty
            sum_weight = 0
            sum_qty = 0
        End If
     Next i

    '清除规格重复值,方法1
     For i = 5 To Rec_rows
      If Cells(i, 2) <> "" Then
        For j = i + 1 To Rec_rows
          If Cells(j, 2) = Cells(i, 2) Then
             Cells(j, 2).Value = ""
             Cells(j, 12).Value = ""
          ElseIf Cells(j, 2) = "" Then
             Exit For
          End If
        Next j
        i = j
      End If
     Next i

'     '清除规格重复值,方法2
'     For i = Rec_rows To 5 Step -1
'        If i > 5 And Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 2) <> "" Then
'            Cells(i, 2).Value = ""
'            Cells(i, 12).Value = ""
'        End If
'     Next i
End Sub

3】打印结果处理

Sub Add_PrintData()
'********************
'     打印结果处理
'********************

    '********复制打印模板数据********
    Sheets("打印模板").Select
    Range("B2:AD26").Select
    Selection.Copy

    '********新建打印结果表********
    Set Sh_res = Worksheets.Add(After:=Sheets("数据处理"))
    Sh_res.Name = "打印结果"
    Sh_res.Select

    Cells.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1                 '设置表格底色为白色
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ActiveSheet.PageSetup.PrintArea = ""
    ActiveSheet.PageSetup.PrintArea = "$B:$AD"
    ActiveSheet.ResetAllPageBreaks

    '********粘贴数据********
    j = 1
    For i = 1 To Page_number
        Range("B" & j + 1).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        ActiveSheet.Paste
        Cells(3 + j, 5) = Sh_cal.Cells(1, 3)
        Cells(3 + j, 14) = Sh_cal.Cells(2, 3)
        Cells(3 + j, 20) = Sh_cal.Cells(3, 3)
        Cells(3 + j, 29) = i & "/" & Page_number
        
        If i > 1 Then
            Range("B" & j).Select                        '第2页开始添加分页符
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell   '添加分页符
        End If
        j = j + 26                                        '下一页行数
    Next i

    '********填充数据********
    For i = 5 To Rec_rows
       cell_page = Fix((i - 5) / (Page_rows * 2))         '得到记录输出所在页数,从0开始表示第1页,1表示第2页,以此类推
       j = (i - 5) Mod 15 + cell_page * 26 + 7            '如果记录行数超过一页能容纳数量,则换页输出
       cell_col = Fix((i - 4) / Page_rows)
       If cell_col Mod 2 <> 0 Then                        '如果记录行数整除页面一栏容纳行数为奇数,则在页面右栏输出
            k = 14
        Else
            k = 0
        End If

        Cells(j, k + 3) = Sh_cal.Cells(i, 12)
        Cells(j, k + 4) = Sh_cal.Cells(i, 2)
        'Cells(j, k + 5) = Sh_cal.Cells(i, 3)  客户下料
        Cells(j, k + 5) = Sh_cal.Cells(i, 5)
        Cells(j, k + 13) = Sh_cal.Cells(i, 4)
        Cells(j, k + 14) = Sh_cal.Cells(i, 11)
        Cells(j, k + 15) = Sh_cal.Cells(i, 10)
        '示意图,如果“其他形状”没有值或者“实际下料”为“合计”,则7~13单元格留空,反之赋值
        If Sh_cal.Cells(i, 9) <> "" Or Sh_cal.Cells(i, 5) = "合计" Then
        Else
            Cells(j, k + 6) = Sh_cal.Cells(i, 6)
            If Sh_cal.Cells(i, 6) <> "" Then
               Cells(j, k + 7) = "┏"
               Cells(j, k + 8) = "━━"
               Cells(j, k + 10) = "━━"
            End If
    
            Cells(j, k + 9) = Sh_cal.Cells(i, 7)
            If Sh_cal.Cells(i, k + 7) <> "" Then
               Cells(j, k + 8) = "━━"
               Cells(j, k + 10) = "━━"
            Else
               Cells(j, k + 9) = "    "
            End If
    
            Cells(j, k + 12) = Sh_cal.Cells(i, 8)
            If Sh_cal.Cells(i, 8) <> "" Then
               Cells(j, k + 11) = "┓"
            End If
         End If
        
        j = j + 1
    Next i
    
    Application.DisplayAlerts = True
End Sub

4】打印设置及后处理

打印设置

Sub Print_set()
'********************
'    打印设置
'********************
    '对于excel2010及以上版本,包含printcommunication属性可以加速打印设置,2007没有就会比较慢
    If Val(Application.Version) >= 14 And Left(Application.OperatingSystem, 3) = "Win" Then
        Application.PrintCommunication = False
    End If
    With ActiveSheet.PageSetup
        '页边距设置
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        '横向打印及设置为置中
        .Orientation = xlLandscape
        .CenterHorizontally = True
        '缩放为1页宽
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 999
    End With
    If Val(Application.Version) >= 14 And Left(Application.OperatingSystem, 3) = "Win" Then
        Application.PrintCommunication = True
    End If

End Sub

后处理

Sub Move_data()
'********************
'    移动数据到工作簿
'********************
    Dim printFile As String
    Dim wbk As Workbook
    
    file_name = Left(wb_name, InStr(wb_name, ".") - 1)
    print_name = file_name & "_打印结果.xlsx"
    print_file = wb_path & "\" & print_name

    On Error Resume Next
    Set wbk = Workbooks(print_name)                        '判断工作簿是否打开
    If Not wbk Then
       Workbooks(print_name).Close
    End If
    
    '删除数据处理工作表
    Application.DisplayAlerts = False
    Sheets("数据处理").Delete
    
    '移动打印结果到新的工作簿
    Sheets("打印结果").Move
    Sheets("打印结果").Select
    Range("C2").Select
    'ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=print_file, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True
    '保存原始记录
    Windows(wb_name).Activate
    Sheets("数据录入").Select
    Range("A5").Select
    ActiveWorkbook.Save
    
    Windows(print_name).Activate
End Sub

最后在“数据录入”工作表中添加一按钮“整理”并指向主程序对应的宏,则完成了整个功能需求的实现。

后记

因编者有其他工作,本需求都是在下班后空余时间进行,从最初始朋友提出需求开始到最后完成,经过了2周左右,其中需求交流大约1个小时不到,开发分析和确定大约2个小时,文档设计和代码编写花了3个晚上共计9个小时左右,最后与朋友测试和调整则用了大约3个小时,也就是总计时间在15个小时左右,反倒是编写这个文档,倒是断断续续花了几个晚上的时间才写完。

对于很多有一定VBA基础的读者来说,此文所述需求和实现并不难;与之前项目实施过程中经常做的数据整理、BPC预算等做的开发相比,也并没有很特别之处;而且如上实现代码还有很多可以优化的地方,如数据的排序、计算、分组等处理,以及数据添加到输出结果等,还可以代码更为简化及调整算法提升处理速度;在开发前后也没想过要写一个文档记录下来,考虑到知识的系统性,之前很少编写一个文档,而是比较倾向于编写系统性的文档。

而现在,这个文档也写出来展现给各读者,啰嗦了那么多,想分享的主要是2点:

其一是向大家分享VBA的使用

如在日常工作或生活的过程中遇到数据处理且繁琐的,可以考虑编写VBA来提高效率,如项目中各种模块的数据整理,是非常有用的;

而且VBA本身难度并不大同时也不需要像Python、Java、Ruby等那样还需要部署开发环境,只要装好Office就可以了;

然后通过VBA还可理解和掌握编程的知识,各种语言其具体的语法、规范、学习难度等可能不一样,但殊途同归,都是为了满足最终的需求,况且随着现在硬件网络等技术的提升,开发人员更多的是考虑如何实现,而性能则其次,如今函数式编程逐渐热门也是如此。

其二是想跟大家分享一直以来的观点:与实现本身相比,理解需求和确定实现思路更为重要

在我们做项目的过程中,包括在业务模块如FICO、MM、SD、PP等的实施,以及ABAP的开发,还有BI的设计等等,都需要我们充分地理解用户的问题、需求,然后综合我们的能力和经验给出可行的解决方案,不要给用户带偏了,用户知道他的问题,但其对解决办法并不一定知道的,用户想要的未必就是最终所要的。

方向错了,结果将很难是对的,轻则延期,重则项目暂停及重来,就像此需求,如果是以OCR为方向,即使识别率再高,出来结果后也很难达到我朋友所要的效果啊。

推荐阅读更多精彩内容

  • 专业考题类型管理运行工作负责人一般作业考题内容选项A选项B选项C选项D选项E选项F正确答案 变电单选GYSZ本规程...
    小白兔去钓鱼阅读 6,955评论 0 13
  • Web网站测试流程和方法(转载) 1测试流程与方法 1.1测试流程 进行正式测试之前,应先确定如何开展测试,不可盲...
    夏了夏夏夏天阅读 207评论 0 0
  • 莫洛的《珍珠与蚌》通过对一粒普通的沙子,不经意间被卷入蚌后,在蚌的艰难孕育和长期磨砺中,最后一粒毫不起眼的普通沙子...
    邢欣阅读 119评论 0 1
  • 24010张莉莉 花甲之年的柳田,遭受丧独之痛后,在绘本里重新拾起对生命的希望,在重温20年前给孩子们阅读绘本的片...
    Love茉莉阅读 25评论 0 0
  • 做老师的这些年,我发现孩子似乎越来越娇气,越来越玻璃心。以下是一年级的孩子时常有的投诉,让人听来实在无法回应。 老...
    颖之老师阅读 88评论 0 3