|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 seeyoutime 于 2012-8-14 15:48 编辑
魔方公式分析工具.zip
(61.58 KB, 下载次数: 123)
开发QQ:215954409 Vba,C#,vb.net程序开发,网站制作
一个魔方的平面分析工具,用来测试魔方公式用的{:soso_e113:}
'部分代码
Dim U(1 To 3, 1 To 3)
Dim F(1 To 3, 1 To 3)
Dim L(1 To 3, 1 To 3)
Dim R(1 To 3, 1 To 3)
Dim D(1 To 3, 1 To 3)
Dim B(1 To 3, 1 To 3)
Sub 初始状态()
With Sheets("1")
For ix = 1 To 3
For iy = 1 To 3
U(ix, iy) = .Cells(ix + 13, iy + 1)
F(ix, iy) = .Cells(ix + 13 + 3, iy + 1)
L(ix, iy) = .Cells(ix + 13 + 6, iy + 1)
R(ix, iy) = .Cells(ix + 13 + 9, iy + 1)
D(ix, iy) = .Cells(ix + 13 + 12, iy + 1)
B(ix, iy) = .Cells(ix + 13 + 15, iy + 1)
Next
Next
End With
保存
End Sub
Sub r状态()
With Sheets("1")
For ix = 1 To 3
For iy = 1 To 3
U(ix, iy) = .Cells(ix + 13, iy + 5)
F(ix, iy) = .Cells(ix + 13 + 3, iy + 5)
L(ix, iy) = .Cells(ix + 13 + 6, iy + 5)
R(ix, iy) = .Cells(ix + 13 + 9, iy + 5)
D(ix, iy) = .Cells(ix + 13 + 12, iy + 5)
B(ix, iy) = .Cells(ix + 13 + 15, iy + 5)
Next
Next
End With
End Sub
Sub 保存()
With Sheets("1")
For ix = 1 To 3
For iy = 1 To 3
.Cells(ix + 13, iy + 5) = U(ix, iy)
.Cells(ix + 13 + 3, iy + 5) = F(ix, iy)
.Cells(ix + 13 + 6, iy + 5) = L(ix, iy)
.Cells(ix + 13 + 9, iy + 5) = R(ix, iy)
.Cells(ix + 13 + 12, iy + 5) = D(ix, iy)
.Cells(ix + 13 + 15, iy + 5) = B(ix, iy)
Next
Next
End With
End Sub
Sub 显示()
With Sheets("1")
For y = 1 To 3
For x = 1 To 3
' 6 '黄 3 '红 41 '蓝 2 '白 10 '绿 46 '橙
If Left(U(y, x), 1) = "黄" Then c = 6
If Left(U(y, x), 1) = "红" Then c = 3
If Left(U(y, x), 1) = "蓝" Then c = 41
If Left(U(y, x), 1) = "白" Then c = 2
If Left(U(y, x), 1) = "绿" Then c = 10
If Left(U(y, x), 1) = "橙" Then c = 46
.Cells(6 + y, 14 + x).Interior.ColorIndex = c '显示颜色
.Cells(6 + y, 14 + x) = U(y, x) 'U '显示标签
If Left(L(y, x), 1) = "黄" Then c = 6
If Left(L(y, x), 1) = "红" Then c = 3
If Left(L(y, x), 1) = "蓝" Then c = 41
If Left(L(y, x), 1) = "白" Then c = 2
If Left(L(y, x), 1) = "绿" Then c = 10
If Left(L(y, x), 1) = "橙" Then c = 46
.Cells(6 + y, 11 + x).Interior.ColorIndex = c
.Cells(6 + y, 11 + x) = L(y, x) 'L
If Left(F(y, x), 1) = "黄" Then c = 6
If Left(F(y, x), 1) = "红" Then c = 3
If Left(F(y, x), 1) = "蓝" Then c = 41
If Left(F(y, x), 1) = "白" Then c = 2
If Left(F(y, x), 1) = "绿" Then c = 10
If Left(F(y, x), 1) = "橙" Then c = 46
.Cells(9 + y, 14 + x).Interior.ColorIndex = c
.Cells(9 + y, 14 + x) = F(y, x) 'F
If Left(B(y, x), 1) = "黄" Then c = 6
If Left(B(y, x), 1) = "红" Then c = 3
If Left(B(y, x), 1) = "蓝" Then c = 41
If Left(B(y, x), 1) = "白" Then c = 2
If Left(B(y, x), 1) = "绿" Then c = 10
If Left(B(y, x), 1) = "橙" Then c = 46
.Cells(3 + y, 14 + x).Interior.ColorIndex = c
.Cells(3 + y, 14 + x) = B(y, x) 'B
If Left(D(y, x), 1) = "黄" Then c = 6
If Left(D(y, x), 1) = "红" Then c = 3
If Left(D(y, x), 1) = "蓝" Then c = 41
If Left(D(y, x), 1) = "白" Then c = 2
If Left(D(y, x), 1) = "绿" Then c = 10
If Left(D(y, x), 1) = "橙" Then c = 46
.Cells(0 + y, 14 + x).Interior.ColorIndex = c
.Cells(0 + y, 14 + x) = D(y, x) 'D
If Left(R(y, x), 1) = "黄" Then c = 6
If Left(R(y, x), 1) = "红" Then c = 3
If Left(R(y, x), 1) = "蓝" Then c = 41
If Left(R(y, x), 1) = "白" Then c = 2
If Left(R(y, x), 1) = "绿" Then c = 10
If Left(R(y, x), 1) = "橙" Then c = 46
.Cells(6 + y, 17 + x).Interior.ColorIndex = c
.Cells(6 + y, 17 + x) = R(y, x) 'R
Next
Next
End With
End Sub
|
|