关于复式排列组合代码问题

HCL13670995161

  在组合数据时,如何根据某些单元格条件进行组合.   由于水平有限. 各位老师能否根据图片的条件编写代码例句..

   1位,2位,相加的个位等于L2:P2单元格里面任何一个数则不组合.如下图

1位,2位,相加的个位等于L2:P2单元格里面任何一个数则不组合.如下图

1位,3位,相加的个位等于L3:P3单元格里面任何一个数则不组合.如下图

6位,7位,相加的个位等于L4:P4单元格里面任何一个数则不组合.如下图

  1,2,3位相加的和个位等于L5:P5单元格里面任何一个数则不组合. 如下图

1,2,3,4,5,6,7,位相加的和个位等于L9:P9单元格里面任何一个数则不组合.如下图

    根据A12:G12,A13:G13,A14:G14,A15:G15单元格内容奇偶进行不组合.

：如何在这里面代码修改 Sub 生成排列()
Dim a$, b$, c$, d$, e$, f$, g$
Dim Ca%, Cb%, Cc%, Cd%, Ce%, Cf%, Cg% 'C=Column
Dim Ra%, Rb%, Rc%, Rd%, Re%, Rf%, Rg% 'R=Row
Dim Pa$, Pb$, Pc$, Pd$, Pe$, Pf$, Pg$ 'P=Parity
Dim Na%, Nb%, Nc%, Nd%, Ne%, Nf%, Ng% 'N=Number
Dim R%, Col%
'On Error Resume Next
Worksheets(2).[A1].CurrentRegion.ClearContents
Ca = WorksheetFunction.CountA(Range("A2:A12"))
Cb = WorksheetFunction.CountA(Range("B2:B12"))
Cc = WorksheetFunction.CountA(Range("C2:C12"))
Cd = WorksheetFunction.CountA(Range("D2:D12"))
Ce = WorksheetFunction.CountA(Range("E2:E12"))
Cf = WorksheetFunction.CountA(Range("F2:F12"))
Cg = WorksheetFunction.CountA(Range("G2:G12"))
If Ca = 0 Then Ca = 1
If Cb = 0 Then Cb = 1
If Cc = 0 Then Cc = 1
If Cd = 0 Then Cd = 1
If Ce = 0 Then Ce = 1
If Cf = 0 Then Cf = 1
If Cg = 0 Then Cg = 1
R = 1
Col = 1
For Ra = 2 To Ca + 1
If Cells(Ra, 1) = "" Then
a = ""
Pa = ""
Na = 0
Else
a = Cells(Ra, 1)
Pa = a Mod 2
Na = Val(a)
End If
For Rb = 2 To Cb + 1
If Cells(Rb, 2) = "" Then
b = ""
Pb = ""
Nb = 0
Else
b = Cells(Rb, 2)
Pb = b Mod 2
Nb = Val(b)
End If
For Rc = 2 To Cc + 1
If Cells(Rc, 3) = "" Then
c = ""
Pc = ""
Nc = 0
c = Cells(Rc, 3)
Pc = c Mod 2
Nc = Val(c)
End If
For Rd = 2 To Cd + 1
If Cells(Rd, 4) = "" Then
d = ""
Pd = ""
Nd = 0
Else
d = Cells(Rd, 4)
Pd = d Mod 2
Nd = Val(d)
End If
For Re = 2 To Ce + 1
If Cells(Re, 5) = "" Then
e = ""
Pe = ""
Ne = 0
Else
e = Cells(Re, 5)
Pe = e Mod 2
Ne = Val(e)
End If
For Rf = 2 To Cf + 1
If Cells(Rf, 6) = "" Then
f = ""
Pf = ""
Else
f = Cells(Rf, 6)
Pf = f Mod 2
Nf = Val(f)
End If
For Rg = 2 To Cg + 1
If Cells(Rg, 7) = "" Then
g = ""
Pg = ""
Ng = 0
Else
g = Cells(Rg, 7)
Pg = g Mod 2
Ng = Val(g)
End If
Do While Worksheets(2).Cells(R, Col) <> ""
Col = Col + 1
If Col = 101 Then
R = R + 1
Col = 1
End If
Loop
Worksheets(2).Cells(R, Col) = a & b & c & d & e & f & g
Next Rg
Next Rf
Next Re
Next Rd
Next Rc
Next Rb
Next Ra
End Sub
请求各位高手指教!!!

如果有高手能解决,请将代码信息发邮件往924576149@QQ.COM.多谢了!!!

香川群子

图片看不到内容。请上传附件。

HCL13670995161

你好,文件经过压缩上传了,附件没有VBA编程器麻烦你了.谢谢!!