按文件名数值排序批量打印Excel文件

起因

  同事求助,工作中经常有一大批Excel表单需要打印,并且打印出来表单是有顺序要求,文件名已经排好了顺序,打印也要按这个顺序打。问我有没有什么快捷的办法。

初次尝试

  刚开始没仔细想这个问题,无非就是排个序嘛,网上随便找了一段实现批量打印Excel文件的VBA代码改一下:先创建一个数组,储存当前目录下的所有Excel文件名,排序后逐个打印。
  把写好的宏文件扔过去试用,才发现没那么简单。文件名是类似1XXXX.xlsx、2XXX.xlsx、……10XXX.xlsx、10XXX.xlsx……。资源管理器里也是按这个顺序显示,打印出来却是1XXX.xlsx、10XXX.xlsx、10XXX.xlsx、……、2XXX.xlsx、21XXX.xlsx……这个顺序。
  想起来从Windows XP开始,资源管理器引入一个新特性就是文件名中的数字按数值顺序而不是按逐位的顺序排列,避免出现之前Windows里1、11、12、……2、21……这样的文件排序
Windows 10组策略编辑器中对数值排序的描述和开关
  但是VBA里字符串比较大小显然是按位来比较的,矛盾由此产生。搜索引擎上找了几个Office批量打印软件,似乎都没有注意这个问题,那么自己动手来解决吧,于是就需要一套实现模仿Windows的文件名数值排序的算法。

分析

  根据网上搜到的一些资料加自己测试,Windows XP及以后版本的资源管理器里,按文件名排序的规则是:

  1. 文件名逐位比较。
  2. 如果同一位两者至少有一个不是数字,则直接按字符比较大小的规则进行比较。
  3. 如果同一位两者都是数字,则将此位开始的连续数字位视为整体,转化为数值进行比较,例如3<22<111。如果数值大小相同但前导0个数不同,则前导0较多的较小,例如000010<0010<10。

算法

(1)整体比较

  我的想法也是按着这个步骤来。

  1. 使用两个String型变量存放要比较的文件名。
  2. 按从左到右的顺序依次在文件名中各取出一位,判定是否数字。
  3. 如果至少有一个不是,则可以使用StrComp()函数比较大小,如果相等则继续取下一位。
  4. 如果都是数字,则将接下来一串连续的数字转化为数值,再进行比较。
  5. 比较的次数不会超过较短文件名的长度,如果最后一次比较完还是相同,则较短的文件名较小。(因为这种环境下不存在两个文件名字完全一样的情况)

(2)数值化及比较

  1. 从当前位置开始,分别设置一个指针,继续向右探测,直到找到不是数字的一位为止,获取两个数值的位数。
  2. 创建两个Integer型数组分别存放两个数值,数组的大小取两个数值中较多的位数(含前导0)。因为考虑到可能会出现超长数字的情况,没有使用单个变量,而是制造两个栈来逐位储存。
  3. 从右往左,也就是从低位向高位,依次将两个数值分别压入栈内,如果栈的大小比其中一个数值位数多,前面空缺位置填充0。
  4. 从高位向低位开始逐位比较。
  5. 如果数值大小相等,则比较前导0的个数,其实就是比较数值的位数。
  6. 如果前导0也一样多,则两个数值完全一样。按(1)的规则从数值右边一位继续比较。

VBA代码

  比较算法搞定了,排序就选个最简单的冒泡排序。

Private Function CompNume(ByVal File1 As String, ByVal File2 As String) As Integer
'对文件名中的数字转化为数值进行比较
'返回1则File1>File2,返回-1则File1<File2
  CompNume = 0
  Dim NameLen1 As Integer, NameLen2 As Integer
  NameLen1 = Len(File1)
  NameLen2 = Len(File2)
  Dim CompareTimes As Integer, ComparePoint As Integer, i As Integer
  Dim NumeValue1() As Integer, NumeValue2() As Integer '存储数值
  Dim CurrPoint As Integer, NumeEndPoint1 As Integer, NumeEndPoint2 As Integer
  Dim CurrChar1 As String, CurrChar2 As String
  If NameLen1 <= NameLen2 Then CompareTimes = NameLen1 Else CompareTimes = NameLen2 '比较次数不超过较短文件名长度
  ComparePoint = 1
  Do While CompNume = 0 And ComparePoint <= CompareTimes
    CurrChar1 = Mid(File1, ComparePoint, 1)
    CurrChar2 = Mid(File2, ComparePoint, 1)
    If IsNumeric(CurrChar1) = False Or IsNumeric(CurrChar2) = False Then
      CompNume = StrComp(CurrChar1, CurrChar2, vbTextCompare)
      '逐位判断是否都是数字,如果至少有一个不是,则直接按文本比较大小
    Else
      '两个文件名同一位置都是数字,先数值化再比较
      NumeEndPoint1 = ComparePoint
      NumeEndPoint2 = ComparePoint
      Do While IsNumeric(Mid(File1, NumeEndPoint1, 1)) = True
        NumeEndPoint1 = NumeEndPoint1 + 1
      Loop
      Do While IsNumeric(Mid(File2, NumeEndPoint2, 1)) = True
        NumeEndPoint2 = NumeEndPoint2 + 1
      Loop
      If NumeEndPoint1 >= NumeEndPoint2 Then CurrPoint = NumeEndPoint1 - 1 - ComparePoint Else CurrPoint = NumeEndPoint2 - 1 - ComparePoint
      '测定数值位数,统一为较长位数开始比较
      ReDim NumeValue1(CurrPoint)
      ReDim NumeValue2(CurrPoint)
      For i = NumeEndPoint1 - 1 To ComparePoint Step -1
        NumeValue1(NumeEndPoint1 - 1 - i) = Mid(File1, i, 1)
      Next i
      For i = NumeEndPoint2 - 1 To ComparePoint Step -1
        NumeValue2(NumeEndPoint2 - 1 - i) = Mid(File2, i, 1)
      Next i
      '分别逐位放入数值数组,低位在前
      '从高位向低位逐位比较
      Do While CompNume = 0 And CurrPoint >= 0
        If NumeValue1(CurrPoint) > NumeValue2(CurrPoint) Then
          CompNume = 1
          ElseIf NumeValue1(CurrPoint) < NumeValue2(CurrPoint) Then
          CompNume = -1
        End If
        CurrPoint = CurrPoint - 1
      Loop
      '数值相同则比较前导0的个数,较少的为大
      If CompNume = 0 Then
        If NumeEndPoint1 > NumeEndPoint2 Then
          CompNume = -1
          ElseIf NumeEndPoint1 < NumeEndPoint2 Then
          CompNume = 1
        End If
      End If
    End If
    If NumeEndPoint1 <> 0 Then '需继续比较,跳到此数值的后一个字符
      ComparePoint = NumeEndPoint1
      NumeEndPoint1 = 0
      NumeEndPoint2 = 0
    Else
      ComparePoint = ComparePoint + 1
    End If
    If CompNume = 0 And ComparePoint = CompareTimes Then '如果比较到最后一次仍然相等,则一个文件名完全属于另一个文件名的一部分
      If NameLen1 < NameLen2 Then
        CompNume = -1
        ElseIf NameLen1 > NameLen2 Then
        CompNume = 1 '此时文件名较长的为大
      End If
    End If
  Loop
End Function

  最后放一个写好的Excel宏文件,可以批量打印文件所在目录下的所有Excel文件,不含子目录,支持按文件名或修改日期升序或降序排列,要打印的Excel文件需要预先设置好版式。

  第一次写VBA程序,边翻书边敲代码,欢迎大家批评。

©️2020 CSDN 皮肤主题: 游动-白 设计师:上身试试 返回首页