通过一题十解谈拓宽编程思路

doitbest

条条大路通罗马，殊途同归，在论坛回帖时，我们经常遇到一个问题的多种解决方案，可谓各有所长，见仁见智，令人倾心于vba强大的功能和魅力。但在我们个人解决问题时，则往往较少考虑一题多解，尤其在已经有了比较好的答案时，更是容易产生思维惰性，缺乏进一步探究的意识和习惯。以下通过对一个比较典型问题的解剖，说明培养一题多解思维的可行性和必要性。就本贴来说，在所有十个解决方案中，也许使用者可能仅会选择其中一两个解决方案，也许除此之外还有更好的解决方案，但不等于这些方案失去了参考价值。一是本贴并非为了追求最优化的解决方案，而是为了拓宽视野，开启思路。二是每种方案在思路和技术点上都有可取之处，都可以在充分消化的基础上，为已所有，增加解决实际问题的能力和知识储备。本贴引用和借鉴了论坛朋友的回复，在此特别感谢“好奇心”和“时光鸟”朋友。

方案1	字典+单元格操作+find
方案2	数组
方案3	数组
方案4	evaluate+单元格操作+find
方案5	数组优化
方案6	单元格操作+match
方案7	单元格操作+find特殊用法
方案8	字典与数组配合
方案9	单元格操作+find+辅助数字
方案10	数组+辅助数字

doitbest

图片演示结果，AB列为数据源，DE列为结果

doitbest

方法1
这个方案是用字典求得1234循环的最大组数，再通过循环将1234读入D列。通过FIND方法确定B列数据在D列的行座标，进而读入E列。此方法是通过分次读入单元格实现的，如果特别大数据量，肯定没有数组方法快，否则就足够用了，看不出速度的差别。另外，与数组相比，读入E列数据是通过一次循环实现的，而数组则要通过两个循环嵌套实现，思路上似乎前者更简明一些。

Public Sub p1()

Dim i, ar,max, d As Object, r As Range

Set d =CreateObject("Scripting.Dictionary")

ar =Range([a2], [b65536].End(3))

For i = 1 ToUBound(ar)  ‘分类统计A列数字的个数

    d(ar(i, 1)) = d(ar(i, 1)) + 1

Next

max =Application.max(d.items)  ‘取最大值作为1234序列的组数

[d:e] =""

For i = 1 Tomax ‘通过循环向D列读入1234序列

    IIf([d1] = "", [d1],[d65536].End(3).Offset(2)).Resize(4) = Application.Transpose(Array(1, 2, 3, 4))

Next

For i = 1 ToUBound(ar) ‘通过D列查找确定行座标，读入E列数据

    Set r = [e65536].End(3).Offset(, -1)

    If r.Row = 1 And r.Offset(, 1) ="" Then

        [e1] = ar(i, 2)

    Else

        r.Resize(UBound(ar)).Find(ar(i, 1), , ,1).Offset(, 1) = ar(i, 2)

    End If

Next

End Sub

doitbest

方法2

此方案是根据A列数字是否具有连续性进行判断，同时向数组读入AB两列数据。其他方案则将先将A列数字读入数组，再读入B列数组。由于思路的差别，导致本方案循环与判断层层嵌套，可读性比较差。

方法2

此方案是根据A列数字是否具有连续性进行判断，同时向数组读入AB两列数据。其他方案则将先将A列数字读入数组，再读入B列数组。由于思路的差别，导致本方案循环与判断层层嵌套，可读性比较差。

Sub p2()

Dim m&,arrPre(), arrRes(), k&, maxNum&

m =Range("a" & Rows.Count).End(3).Row

If m < 3Then Exit Sub

arrPre =Range("a1:b" & m).Value

ReDim arrRes(1To Rows.Count - 1, 1 To 2)

For i = 2 To m‘确定1234序列的最大组数

    maxNum = Application.max(maxNum, arrPre(i,1))

Next i

k = 0

For i = 2 To m

    v1 = Val(arrPre(i - 1, 1)): v2 =Val(arrPre(i, 1))

    If v1 + 1 <> v2 Then ‘如果相邻数组值不连续

       If v1 < maxNum And i > 2 Then ‘如果V1大于最大值4，则向数组arrRes第一列读入v1 + 1至4，第二列数组值为空，起到占位作用

          For j = v1 + 1 To maxNum

              k = k + 1: arrRes(k, 1) = j:arrRes(k, 2) = ""

          Next j

       End If

       If i > 2 Then k = k + 1  ‘增加一个空白行，即4下面的一行数组值为空

       If v2 > 1 Then ‘如果V2大于1，则向数组arrRes第一列读入1 至 v2 – 1几个数字，第二列为空，起到占位的作用

          For j = 1 To v2 - 1

              k = k + 1: arrRes(k, 1) = j:arrRes(k, 2) = ""

          Next j

       End If

    End If

    k = k + 1: arrRes(k, 1) = v2: arrRes(k, 2)= arrPre(i, 2) ‘将AB列数据读入数组arrRes

    If i = m And arrPre(m, 1) < maxNum Then ‘如果循环到最后一个值，且该行A列值小于4，则向数组第一列写入arrPre(m, 1) + 1 至4，起到占位作用

       For j = arrPre(m, 1) + 1 To maxNum

              k = k + 1: arrRes(k, 1) = j:arrRes(k, 2) = ""

          Next j

    End If

Next i

Range("d2:e"& Rows.Count).ClearContents

[d2].Resize(IIf(k> Rows.Count - 1, Rows.Count - 1, k), 2) = arrRes

End Sub

doitbest

方法3
这个方案是完全通过数组的方法实现的，包括读入D列和E列数据。数组方案的最大优势是速度快，但代码似乎有点“啰嗦”，有时思路也不太容易理清。但这也不是绝对的，因各人思维习惯和喜好而异。此外，本程序读入D列数据的思路是这样的：首先读入尽可能多的1234组，等到E列数据读入后，再将D列多余数据删除。这种思路可能会引起争议，并非是最优的方案，但只要能够启发思路，就达到发帖的初衷了。
Public Sub p3()
Dim arr, brr(), i, j, n
arr = Range("a2:b" & [a65536].End(3).Row)
ReDim brr(1 To UBound(arr) * 5, 1 To 2)
For i = 1 To UBound(arr) ‘向数组第一列读入1234序列
    n = n + 5
    brr(n - 4, 1) = 1
    brr(n - 3, 1) = 2
    brr(n - 2, 1) = 3
    brr(n - 1, 1) = 4
Next

For i = 1 To UBound(arr)  ‘通过两个循环嵌套，将数组ARR与BRR第一列比对
  For j = i To UBound(brr)
    If arr(i, 1) = brr(j, 1) And brr(j, 2) = "" Then  ‘如果第一列数字相等，且BRR第二列未读入值
      brr(j, 2) = arr(i, 2)
      Exit For
    End If
  Next
Next
Range("d2").Resize(UBound(brr), 2) = brr
Erase arr, brr
Range([d:d].Find("", [e65536].End(3).Offset(, -1), , 1), [d65536].End(3)) = "" ‘将没有对应值的数字序列删除，通过FIND查找夹在序列中的空白单元格所在行
End Sub

doitbest

方法4
这个方案是方法1的“变种”，二者差别在于本方案通过evaluate方法确定D列1234序列的最大组数，而方法1是通过字典实现的。之所以称为“变种”，是因为无法断定两者孰优孰劣，而不能称为升级版或改进版。evaluate方法功能强大，通过一条语句就能完成多条循环判断语句才能实现的功能，其能够实现许多数组公式的计算功能，优点非常突出。但其缺点是代码可读性不强，较长语句调试会比较费事，尤其会对代码调试经验不足者造成困扰。代码的速度和简洁是我们所追求的，但代码的兼容性和可维护性也是要兼顾的，不可厚此薄彼，有所偏废。函数版中过于追求公式精简或一句搞定的习气比较突出，VBA版中发帖和回帖中往往也有这个倾向，这是不可取的，需要引以为鉴。
Public Sub p4()
Dim i, ar, max, d As Object, r As Range, rng As Range
ar = Range([A2], [b65536].End(3))
Set rng = Range([A2], [a65536].End(3))
max = Evaluate("MAX(COUNTIF(" & rng.Address & "," & rng.Address & "))") ‘作用相当于数组公式“＝MAX(COUNTIF(A2:A10,A2:A10))”，取得1234序列的最大组数
[d:e] = ""
For i = 1 To max ‘向D列读入1234序列
    IIf([d1] = "", [d1], [d65536].End(3).Offset(2)).Resize(4) = Application.Transpose(Array(1, 2, 3, 4))
Next
For i = 1 To UBound(ar)
    Set r = [e65536].End(3).Offset(, -1)
    If r.Row = 1 And r.Offset(, 1) = "" Then
        [e1] = ar(i, 2)
    Else
        r.Resize(UBound(ar)).Find(ar(i, 1), , , 1).Offset(, 1) = ar(i, 2) ‘用FIND方法确定行座标，并向该行E列读入值
    End If
Next
End Sub

doitbest

方法5
这个方案是方法2的优化版，在A列与D列数据比对时（实际是数组比对，为容易理解如此表述），加入了一个变量N发挥指针作用，使每次循环都在不断累加的变量N的基础上进行，减少了比对次数。这在数据量少时根本看不出差别，数据量大会体现其优势。将这个方案单独列出，其目的是说明代码的优化是VBA爱好者需要追求的永恒主题，不管水平多高、代码多么精雕细琢，往往都是有优化余地的。在许多人看来，在代码中过于精益求精似有“洁癖”的嫌疑，但这种好习惯会使你在其他解决方案中受益匪浅。
Public Sub p5()
Rem it is 3.1
Dim arr, brr(), i, j, n
arr = Range("a2:b" & [a65536].End(3).Row)
ReDim brr(1 To UBound(arr) * 5, 1 To 2)
For i = 1 To UBound(arr)
    n = n + 5
    brr(n - 4, 1) = 1
    brr(n - 3, 1) = 2
    brr(n - 2, 1) = 3
    brr(n - 1, 1) = 4
Next
n = 1
For i = 1 To UBound(arr)
  For j = n To UBound(brr)
    If arr(i, 1) = brr(j, 1) And brr(j, 2) = "" Then
      brr(j, 2) = arr(i, 2)
      n = j ‘下次以N为起始行在BRR中循环，最大限度减少循环次数
      Exit For
    End If
  Next
Next
Range("d2").Resize(UBound(brr), 2) = brr
Erase arr, brr
Range([d:d].Find("", [e65536].End(3).Offset(, -1), , 1), [d65536].End(3)) = ""
End Sub

doitbest

方法6
这个方案与方法1相似，差别在于此方案是通过工作表函数match确定读入E列的行座标，代替了原方案的FIND方法。Match 与FIND两种方法功能接近，许多时候可以互相代替使用。相比之下，MATCH函数参数较少，使用方便不容易出错，支持模糊查找和数组查找，其所谓缺点是只能查找单列，只能返回值，不能返回对象。FIND方法功能强大，没有上述MATCH函数的缺点，且常有惊人的表现。最可惜的是FIND不支持数组查找（如果能做到这点该有多好，我们会少耗费多少所谓构思、循环判断的精力啊！）尽管FIND本质上也是循环，但毕竟我们看不到，不用操那份心。FIND方法复杂的参数决定了其掌握的难度，完全掌握则需要大量的应用和调试经验，往往由于隐性和显性参数的设置问题，导致出现疑难杂症，令人一筹莫展。就如美国的航天飞机，值钱、高技术扎堆，但出现问题也真够受的！而我们的神舟系列则小而美，性价比高，老“皮实“了！
Public Sub p6()
Dim i, ar, max, d As Object, r As Range, ro
Set d = CreateObject("Scripting.Dictionary")
ar = Range([A2], [b65536].End(3))
For i = 1 To UBound(ar)
    d(ar(i, 1)) = d(ar(i, 1)) + 1
Next
max = Application.max(d.items)
[d:e] = ""
For i = 1 To max
    IIf([d1] = "", [d1], [d65536].End(3).Offset(2)).Resize(4) = Application.Transpose(Array(1, 2, 3, 4))
Next
For i = 1 To UBound(ar)
    Set r = [e65536].End(3).Offset(, -1)
    ro = Application.Match(ar(i, 1), Cells(r.row, 4).Resize(UBound(ar) * 5), 0) ‘用MATCH确定在查找区域的行相对位置
    Cells(r.row + ro - 1, 5) = ar(i, 2) ‘r.row + ro – 1作用是将行相对位置转化为行绝对位置
Next
End Sub

doitbest

方法7
此方案没有利用数组，纯粹单元格操作。根据A列是否连续的特点，利用N作为复制B列区域的行起止指针，同时将数据读入到DE两列。由于变量N的作用，本程序只用了一个循环就达到了要求，以此为代价，if判断相应明显增加。
Public Sub p7()
Dim x As Range, i, n, rng As Range
[d:e] = ""
n = 2
For i = 2 To [a65536].End(3).row
    If (Cells(i, 1) - Val(Cells(i - 1, 1))) <> 1 Or i = [a65536].End(3).row Then ‘如果A列值不连续或者为最后一行，即满足连续单元格区域复制的条件
        IIf([d1] = "", [d1], [d65536].End(3).Offset(2)).Resize(4) = Application.Transpose(Array(1, 2, 3, 4)) ‘向D列写入1234序列
        If i <> 2 Then
            Set rng = [d:d].Find(Cells(n, 1), , , 1, , 2) ‘在D列倒序查找A列连续区域的第一个数字，其所在行为下步复制目标区域的起始行，注意FIND的最后一个参数2为倒序查找
            If i <> [a65536].End(3).row Then ‘根据I值是否为最后一行，确定不同的复制区域
                Range(Cells(n, 2), Cells(i - 1, 2)).Copy rng.Offset(, 1)
            Else
                Range(Cells(n, 2), Cells(i, 2)).Copy rng.Offset(, 1)
            End If
            n = i
        End If
    End If
Next
End Sub

doitbest

方法8
此方案是字典与数组配合的示例，字典的用法相对比较特殊，即用变量N形成组序号，用N与A列数字形成具有唯一性的字典键值，为后面的数组调用奠定基础。通过组序号与1－4数字的双循环形成D列的数据，再以其为键值调用字典的值，形成E列的数据。具体解释一下组序号，D列第一组1234的组序号为1，往下第二组1234的组序号为2，以此类推。
Public Sub p8()
Dim ar, br(), i, j, k, m, n, max, rng As Range
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Set rng = Range([a2], [a65536].End(3))
max = Evaluate("MAX(COUNTIF(" & rng.Address & "," & rng.Address & "))")
ar = Range([a1], [b65536].End(3))
ReDim br(1 To rng.Count * 5, 1 To 2)
m = 2: n = 1
For i = 2 To UBound(ar)
    If i <> 2 And ar(i, 1) <> (Val(ar(i - 1, 1)) + 1) Then n = n + 1 ‘如果相邻数值是非连续的，则1234的组序号加1
    d(ar(i, 1) & n) = ar(i, 2) ‘数字和组序号作为字典的KEY，B列值作为ITEM
Next
n = 0
For i = 1 To max
    n = n + 5 ‘行指针增加5，因为1、2、3、4及空格共占用五行
    For j = 1 To 4
        br(n - 5 + j, 1) = j ‘向数组第一列写入数字1234
        If d.exists(j & n / 5) Then br(n - 5 + j, 2) = d(j & n / 5) ‘如果数组BR的第一列值在字典中存在，则将字典的ITEM读入数组第二列
    Next
Next
[d:e] = ""
[d1].Resize(UBound(br), 2) = br
End Sub