求三个数相加尾相同等式代码

abc3d

A	B	C	D
0	3	8	9
3	9	0	4
6	7	9	0
4	5	1	8
9	0	4	5
1	4	2	5
5	7	2	6
4	8	2	4

求三个数相加尾相同等式代码

例如：黑色加粗字体的（①）A4+C2+A5=4+1+9=4，粉红字体的②C3+D3+D5=9+0+5=4，同时对应的③A5+C3+A6=④C4+D4+D6

说明1：同时满足条件①=②（指尾数），③=④，不是①=②=③=④

说明2：①③、②④具有同等对应关系,例如①下拉可一行得到③，即（①）A4+C2+A5下拉一行是②A4+C3+A6，当然可以不下拉或下拉两行、三行主要是说其同等对应关系。

说明3：一个等式的三个数字每行最多出现两个

说明4：每组数据固定4列8行，A1=B1+C1+D1之尾

说明5：一组数据可能出现多个等式，不知道怎样表明等式代码更容易实现，或者不同等式标出不同颜色，当然能在旁边列出等式  最好比如 A4+C2+A5=C3+D3+D5

说明6：最好将代码直接保存在excel工作表中，下载即可使用。（本人初识VBA，还不会保存代码）

说明6：非常感谢您的指教！顺祝五一节快乐！事事如意！

如果没说清楚，我会跟贴继续说明。谢谢！

香川群子

看懂了，代码也写好了。

不过运行起来可能耗时太长……符合条件的结果太多了。

1. 
   
2. Sub kagawa() '2014/04/25
   
3.     Dim i11&, j11&, i12&, j12&, i13&, j13&
   
4.     Dim i21&, j21&, i22&, j22&, i23&, j23&
   
5.     Dim t11&, t21&, t12&, t22&, r&, s$, tms#
   
6.     tms = Timer
   
7. '    arr = [a1:d8]
   
8.     Dim arr&(1 To 8, 1 To 4)
   
9.     Dim brr&(1 To 8, 1 To 4)
   
10.     For i11 = 1 To 8
    
11.       For j11 = 1 To 4
    
12.         arr(i11, j11) = Cells(i11, j11)
    
13.       Next
    
14.     Next
    
15.    
    
16.     r = 12
    
17.     For i11 = 1 To 6
    
18.       For j11 = 1 To 4
    
19.         brr(i11, j11) = 1
    
20.         For i12 = 1 To 7
    
21.           For j12 = IIf(i11 = i12, j11 + 1, 1) To 4
    
22.             If brr(i12, j12) Then Stop
    
23.             brr(i12, j12) = 1
    
24.             For i13 = i11 + 1 To 7
    
25.               For j13 = IIf(i12 = i13, j12 + 1, 1) To 4
    
26.                 If brr(i13, j13) Then Stop
    
27.                 brr(i13, j13) = 1
    
28.                
    
29.     For i21 = i11 To 6
    
30.       For j21 = IIf(i11 = i21, j11 + 1, 1) To 4
    
31.         If brr(i21, j21) Then
    
32. '          Stop 'pass
    
33.         Else
    
34.           brr(i21, j21) = 1
    
35.           For i22 = 1 To 7
    
36.             For j22 = IIf(i21 = i22, j21 + 1, 1) To 4
    
37.               If brr(i22, j22) Then
    
38. '                Stop 'pass
    
39.               Else
    
40.                 brr(i22, j22) = 1
    
41.                 For i23 = i21 + 1 To 7
    
42.                   For j23 = IIf(i22 = i23, j22 + 1, 1) To 4
    
43.                     If brr(i23, j23) Then
    
44. '                      Stop 'pass
    
45.                     Else
    
46.                     
    
47.                       t11 = (arr(i11, j11) + arr(i12, j12) + arr(i13, j13)) Mod 10
    
48.                       t21 = (arr(i21, j21) + arr(i22, j22) + arr(i23, j23)) Mod 10
    
49.                       If t11 = t21 Then
    
50.                         t12 = (arr(i11 + 1, j11) + arr(i12 + 1, j12) + arr(i13 + 1, j13)) Mod 10
    
51.                         t22 = (arr(i21 + 1, j21) + arr(i22 + 1, j22) + arr(i23 + 1, j23)) Mod 10
    
52.                         If t12 = t22 Then
    
53. '                          Stop
    
54.                           Cells(r, 1) = Cells(i11, j11).Address(0, 0)
    
55.                           Cells(r, 2) = Cells(i12, j12).Address(0, 0)
    
56.                           Cells(r, 3) = Cells(i13, j13).Address(0, 0)
    
57.                           
    
58.                           Cells(r, 5) = Cells(i21, j21).Address(0, 0)
    
59.                           Cells(r, 6) = Cells(i22, j22).Address(0, 0)
    
60.                           Cells(r, 7) = Cells(i23, j23).Address(0, 0)
    
61.                           
    
62.                           Cells(r, 9) = Cells(i11 + 1, j11).Address(0, 0)
    
63.                           Cells(r, 10) = Cells(i12 + 1, j12).Address(0, 0)
    
64.                           Cells(r, 11) = Cells(i13 + 1, j13).Address(0, 0)
    
65.                           
    
66.                           Cells(r, 13) = Cells(i21 + 1, j21).Address(0, 0)
    
67.                           Cells(r, 14) = Cells(i22 + 1, j22).Address(0, 0)
    
68.                           Cells(r, 15) = Cells(i23 + 1, j23).Address(0, 0)
    
69.                           r = r + 1
    
70.                           
    
71.                           Cells(r, 1) = arr(i11, j11)
    
72.                           Cells(r, 2) = arr(i12, j12)
    
73.                           Cells(r, 3) = arr(i13, j13)
    
74.                           Cells(r, 4) = t11
    
75.                           Cells(r, 5) = arr(i21, j21)
    
76.                           Cells(r, 6) = arr(i22, j22)
    
77.                           Cells(r, 7) = arr(i23, j23)
    
78.                           
    
79.                           Cells(r, 9) = arr(i11 + 1, j11)
    
80.                           Cells(r, 10) = arr(i12 + 1, j12)
    
81.                           Cells(r, 11) = arr(i13 + 1, j13)
    
82.                           Cells(r, 12) = t22
    
83.                           Cells(r, 13) = arr(i21 + 1, j21)
    
84.                           Cells(r, 14) = arr(i22 + 1, j22)
    
85.                           Cells(r, 15) = arr(i23 + 1, j23)
    
86.                           r = r + 1
    
87.                         End If
    
88.                       End If
    
89.    
    
90.                     End If
    
91.                   Next
    
92.                 Next
    
93.                 brr(i22, j22) = 0
    
94.               End If
    
95.             Next
    
96.           Next
    
97.           brr(i21, j21) = 0
    
98.         End If
    
99.       Next
    
100.     Next
     
101.                 brr(i13, j13) = 0
     
102.               Next
     
103.             Next
     
104.             brr(i12, j12) = 0
     
105.           Next
     
106.         Next
     
107.         brr(i11, j11) = 0
     
108.       Next
     
109.     Next
     
110.    
     
111.     MsgBox Format(Timer - tms, "0.000s")
     
112. End Sub
     

复制代码

香川群子

上附件。自己运行一下看需要多少时间。

abc3d

香川群子 发表于 2014-4-25 20:50
看懂了，代码也写好了。

不过运行起来可能耗时太长……符合条件的结果太多了。

谢谢版主！
首先条件1与条件2单元格不能重复，首先条件3与条件4单元格不能重复
同时满足（1=2）*（3=4）的为一个等式

abc3d

①A4+C2+A5
③A5+C3+A6

②C3+D3+D5
④C4+D4+D6

您看1与3差1行  2与4也差一行   这就是上面说的对应关系

1/满足1=2         2/满足3=4       3/满足上面的对应关系

三个条件都具备为一个等式，估计满足条件的不超过5个等式

abc3d

看到附件了，正是要的，能不能再加一个条件，求版主改为4列6行，就是1234等式之间的行数<=4.

香川群子

abc3d 发表于 2014-4-25 21:17
①A4+C2+A5
③A5+C3+A6

经过计算，8行4列时，满足条件的①②③④算一组，那么一共有 210,211组。
2007版新程序计算和输出，总耗时大约半分钟。（检查有效组合 20,996,136组）


6行4列时，满足条件的共有 17,091组 （检查有效组合 1,725,840组）

香川群子

abc3d 发表于 2014-4-25 21:21
看到附件了，正是要的，能不能再加一个条件，求版主改为4列6行，就是1234等式之间的行数

那这样缩减行数以后，计算结果数大大减少……剩下 17091组

程序修改：
① 行列大小自动按照A1所在区域的实际行、列数。
② 计算结果存入数组，按5000次单位输出到工作表

1. Sub kagawa() '2014/04/25
   
2.     Dim i11&, j11&, i12&, j12&, i13&, j13&
   
3.     Dim i21&, j21&, i22&, j22&, i23&, j23&
   
4.     Dim t11&, t21&, t12&, t22&
   
5.     Dim ar, m&, n&, r&, s$, cnt&, tms#
   
6.     tms = Timer
   
7.    
   
8.     ar = [a1].CurrentRegion
   
9.     m = UBound(ar): n = UBound(ar, 2)
   
10.     ReDim arr&(1 To m, 1 To n)
    
11.     ReDim brr&(1 To m, 1 To n)
    
12.     For i11 = 1 To m
    
13.       For j11 = 1 To n
    
14.         arr(i11, j11) = Cells(i11, j11)
    
15.       Next
    
16.     Next
    
17.    
    
18.     ReDim crr(1 To 10000, 1 To 15)
    
19.     [h11] = 0: r = 0
    
20.     [a11].CurrentRegion.Offset(2) = ""
    
21.     For i11 = 1 To m - 2
    
22.       For j11 = 1 To n
    
23.         brr(i11, j11) = 1
    
24.         For i12 = 1 To m - 1
    
25.           For j12 = IIf(i11 = i12, j11 + 1, 1) To n
    
26.             'If brr(i12, j12) Then Stop
    
27.             brr(i12, j12) = 1
    
28.             For i13 = i11 + 1 To m - 1
    
29.               For j13 = IIf(i12 = i13, j12 + 1, 1) To n
    
30.                 'If brr(i13, j13) Then Stop
    
31.                 brr(i13, j13) = 1
    
32.                
    
33.     For i21 = i11 To m - 2
    
34.       For j21 = IIf(i11 = i21, j11 + 1, 1) To n
    
35.         If brr(i21, j21) Then
    
36. '          Stop 'pass
    
37.         Else
    
38.           brr(i21, j21) = 1
    
39.           For i22 = 1 To m - 1
    
40.             For j22 = IIf(i21 = i22, j21 + 1, 1) To n
    
41.               If brr(i22, j22) Then
    
42. '                Stop 'pass
    
43.               Else
    
44.                 brr(i22, j22) = 1
    
45.                 For i23 = i21 + 1 To m - 1
    
46.                   For j23 = IIf(i22 = i23, j22 + 1, 1) To n
    
47.                     If brr(i23, j23) Then
    
48. '                      Stop 'pass
    
49.                     Else
    
50.                       cnt = cnt + 1   
    
51.                       t11 = (arr(i11, j11) + arr(i12, j12) + arr(i13, j13)) Mod 10
    
52.                       t21 = (arr(i21, j21) + arr(i22, j22) + arr(i23, j23)) Mod 10
    
53.                       If t11 = t21 Then
    
54.                         t12 = (arr(i11 + 1, j11) + arr(i12 + 1, j12) + arr(i13 + 1, j13)) Mod 10
    
55.                         t22 = (arr(i21 + 1, j21) + arr(i22 + 1, j22) + arr(i23 + 1, j23)) Mod 10
    
56.                         If t12 = t22 Then
    
57. '                          Stop
    
58.                           r = r + 1
    
59.                           crr(r, 1) = Cells(i11, j11).Address(0, 0)
    
60.                           crr(r, 2) = Cells(i12, j12).Address(0, 0)
    
61.                           crr(r, 3) = Cells(i13, j13).Address(0, 0)
    
62. 
    
63.                           crr(r, 5) = Cells(i21, j21).Address(0, 0)
    
64.                           crr(r, 6) = Cells(i22, j22).Address(0, 0)
    
65.                           crr(r, 7) = Cells(i23, j23).Address(0, 0)
    
66. 
    
67.                           crr(r, 9) = Cells(i11 + 1, j11).Address(0, 0)
    
68.                           crr(r, 10) = Cells(i12 + 1, j12).Address(0, 0)
    
69.                           crr(r, 11) = Cells(i13 + 1, j13).Address(0, 0)
    
70. 
    
71.                           crr(r, 13) = Cells(i21 + 1, j21).Address(0, 0)
    
72.                           crr(r, 14) = Cells(i22 + 1, j22).Address(0, 0)
    
73.                           crr(r, 15) = Cells(i23 + 1, j23).Address(0, 0)
    
74.                           
    
75.                           r = r + 1
    
76.                           crr(r, 1) = arr(i11, j11)
    
77.                           crr(r, 2) = arr(i12, j12)
    
78.                           crr(r, 3) = arr(i13, j13)
    
79.                           crr(r, 4) = t11
    
80.                           crr(r, 5) = arr(i21, j21)
    
81.                           crr(r, 6) = arr(i22, j22)
    
82.                           crr(r, 7) = arr(i23, j23)
    
83. 
    
84.                           crr(r, 9) = arr(i11 + 1, j11)
    
85.                           crr(r, 10) = arr(i12 + 1, j12)
    
86.                           crr(r, 11) = arr(i13 + 1, j13)
    
87.                           crr(r, 12) = t22
    
88.                           crr(r, 13) = arr(i21 + 1, j21)
    
89.                           crr(r, 14) = arr(i22 + 1, j22)
    
90.                           crr(r, 15) = arr(i23 + 1, j23)
    
91.                           
    
92.                           If r = 10000 Then
    
93.                             Cells(Cells.Rows.Count, 1).End(3).Offset(1).Resize(10000, 15) = crr
    
94.                             [h11] = [h11] + 5000: r = 0
    
95.                           End If
    
96.                           
    
97.                         End If
    
98.                       End If
    
99.    
    
100.                     End If
     
101.                   Next
     
102.                 Next
     
103.                 brr(i22, j22) = 0
     
104.               End If
     
105.             Next
     
106.           Next
     
107.           brr(i21, j21) = 0
     
108.         End If
     
109.       Next
     
110.     Next
     
111.    
     
112.         Application.StatusBar = i11 & "," & j11 & " " & i12 & "," & j12 & " " & i13 & "," & j13 & "| " & [h11] + r / 2
     
113.                 brr(i13, j13) = 0
     
114.               Next
     
115.             Next
     
116.             brr(i12, j12) = 0
     
117.           Next
     
118.         Next
     
119.         brr(i11, j11) = 0
     
120.       Next
     
121.     Next
     
122.     [h11] = [h11] + r / 2
     
123.     Application.StatusBar = i11 & "," & j11 & " " & i12 & "," & j12 & " " & i13 & "," & j13 & "| " & [h11]
     
124.     If r Then Cells(Cells.Rows.Count, 1).End(3).Offset(1).Resize(r, 15) = crr
     
125.     MsgBox Format(Timer - tms, "0.000s ") & [h11] & " / " & cnt
     
126. End Sub
     

复制代码

附件为2003版 和 2007版
二组尾数相同2.rar (32.14 KB, 下载次数: 21)

2014-4-25 22:49 上传

点击文件名下载附件

abc3d

香川群子 发表于 2014-4-25 22:26
那这样缩减行数以后，计算结果数大大减少……剩下 17091组

程序修改早早起来测试一下，数据之多远远超出想象，想请版主再修改下

修改：四个等式中最后一行只能出现一个数，例如
A1        B1        A2                B2        A3        D3                A2        B2        A3                B3        A4        D4
上面四个等式的最后一行为第四行，但第四行出现A4、D4两个数，这样的等式不显示。即行数最大的一行中只有一个值参与计算。