一组数据处理，处理规则比较多，如何写一个容易扩展的程序？

jiangtaowoo

待处理的数据有 26 列，24 行，每行数据有对应的几个参照数据 abcd，处理规则一般是判断abcd是否包含在数据中，详见附件。
由于处理规则很多，每一条规则需要输出一组与输入数据对应的判断结果（24行*26列），请问如何写一个容易扩展规程的程序。

数据是这样的（前面四个数据是abcd，后面是正式数据，只列了少量几列）

0        5        6        2                51089        69048        31687        95743        03761        75360
1        3        9        7                51089        69048        23168        29574        30761        97536
2        7        4        9                45108        06948        82316        29574        83076        69753

规则长这样：
规则序号        输出工作簿名称        数据计算规则        举例（以F2单元格数据为例）
1        s1        是否包含本行b列数据        F2内容为 52089 本行B列数据为5，因此判断结果为yes，输出Y
2        s2        是否包含本行c列数据        F2内容为 52089 本行C列数据为6，因此判断结果为no，输出N
3        s3        是否包含本行(B列+C列)的个位数        F2内容为 52089 本行B列＋C列结果为11，其个位数为1，因此判断结果为no，输出N
4        s4        单元格的345位内容是否包含本行A列数据        F2内容为 52089，其345位内容为089， 本行A列内容为0，因此判断结果为yes，输出Y

谢谢各位大神指点！

Chip_Kenny

try this:

1. Sub zz()
   
2. Dim ar, br(), s$, a%, b%, c%, s3%, s4$, s5$, s6$, t$
   
3. ar = Sheets(1).Range("a2:ae" & Sheets(1).[a1048576].End(3).Row).Value
   
4. ReDim br(1 To UBound(ar), 1 To 26)
   
5. t = "0123456789"
   
6. For i = 1 To UBound(ar)
   
7.     a = ar(i, 1): b = ar(i, 2): c = ar(i, 3): s3 = Right(b + c, 1):
   
8.     For j = 6 To UBound(ar, 2)
   
9.         s = ar(i, j): s4 = Mid(s, 3, 3): s5 = Mid(s, 4, 1) & Mid(s, 1, 1): s6 = t
   
10.         For jj = 1 To Len(s)
    
11.             s6 = Replace(s6, Mid(s, jj, 1), "")
    
12.         Next
    
13.         br(i, j - 5) = IIf(InStr(s, b), "Y", "N")                                           's1
    
14.         br(i, j - 5) = br(i, j - 5) & "," & IIf(InStr(s, c), "Y", "N")              's2
    
15.         br(i, j - 5) = br(i, j - 5) & "," & IIf(Right(s, 1) = s3, "Y", "N")      's3
    
16.         br(i, j - 5) = br(i, j - 5) & "," & IIf(InStr(s4, a), "Y", "N")             's4
    
17.         br(i, j - 5) = br(i, j - 5) & "," & IIf(InStr(s5, b), "Y", "N")             's5
    
18.         br(i, j - 5) = br(i, j - 5) & "," & IIf(InStr(s6, b), "Y", "N")             's5
    
19.     Next
    
20. Next
    
21. Sheets(3).Copy
    
22. [b2].Resize(UBound(br), 26) = br
    
23. End Sub

复制代码

jiangtaowoo

Chip_Kenny 发表于 2018-3-22 10:08
try this:

谢谢你的回复。
这个代码可以算出结果。结果需要按照规则对应放到不同的输出工作簿中。
是否有可能设计一个类似zz的函数，使得新增规则时，能维持zz的主体逻辑不变（遍历原数据24行*26列，按照要求规则计算结果，输出到指定工作簿），这样扩展规则就会方便许多。
因为实际上类似的规则还有很多，我举例里只列举了一些例子。比如一个新的判断规则可能为A＋B之和的个位数是否包含于 数据单元格第2位数据相邻的两个数字之中。
希望扩展规则时，能够保持主体计算逻辑不用动，有没有什么好办法呢。

Chip_Kenny

扩展规则一定要收修代码的，我的代码祇是各种思路中的一种而已，如楼主觉得可行，想改成函数或甚么是，楼主可以自行修改。