正式版发布：强大的旋转变换与对称变换自定义函数

aoe1981

　　从标题来看，应当合写一个自定义函数或者分写两个自定义函数。
　　一开始，我试图合写一个自定义函数，具有两种功能：旋转变换、对称变换。但写着写着，发现二者在坐标引用上完全不一样，最好或者是只能分开写。
　　现在，有点迫不及待，只做了一个旋转变换的自定义函数，也反复测试了许久，有点小激动，便先发一下，因为，距离把对称变换的搞出来，还得一段时间……
　　所以激动，是因为感觉自己所做的比TRANSPOSE()函数都强大一些……当然，也可能是我的无知与自大。但，无知者常无畏。
　　至于标题中的“强大”二字，呵呵，这可能是我一贯的作风了：自吹自擂，哈哈，夺人眼球！
　　废话少叙，上附件：
　　 旋转与对称变换自定义函数.rar (13.9 KB, 下载次数: 53)

2014-10-3 18:30 上传

点击文件名下载附件

　　（以8楼附件为基准，包括各楼层粘贴的代码均让位于8楼附件）




　　完整解决的正式版附件见8楼，请直接下载8楼附件：
　　http://club.excelhome.net/forum. ... 1156193&pid=7878947

　　参数说明见11楼：
　　http://club.excelhome.net/forum. ... 1156193&pid=7878956

aoe1981

代码如下：

1. Option Explicit
   
2. Public Function XuanZhuan(rng As Range, jd%, Optional ro% = 0, Optional col% = 0)
   
3. If jd <> 90 And jd <> 180 And jd <> 270 Then XuanZhuan = "旋转角度取值应为：90、180、270度！": Exit Function
   
4. Dim arr, h%, l%, i%, j%, hl%, x!, y!, ds#, h1%, l1%, m%, k%
   
5. arr = rng.Value '原始数据数组
   
6. h = UBound(arr): l = UBound(arr, 2)
   
7. hl = WorksheetFunction.Max(h, l): ds = jd / 180 * Application.Pi()
   
8. ReDim brr(-hl To hl, -hl To hl) '过渡数组
   
9. For i = 1 To h '对应y
   
10.     For j = 1 To l '对应x
    
11.         x = j * Cos(ds) - i * Sin(ds)
    
12.         y = j * Sin(ds) + i * Cos(ds)
    
13.         brr(y, x) = arr(i, j)
    
14.     Next j
    
15. Next i
    
16. h1 = 0: l1 = 0
    
17. For i = -hl To hl '非空列
    
18.     m = 0
    
19.     For j = -hl To hl
    
20.         If brr(i, j) <> "" Then m = m + 1
    
21.     Next j
    
22.     If l1 < m Then l1 = m
    
23. Next i
    
24. If l1 = l Then h1 = h Else h1 = l '非空行
    
25. ReDim crr(1 To h1, 1 To l1)
    
26. m = 0: k = 1
    
27. For i = -hl To hl '剔除brr中的空值，保留非空值位置
    
28.     For j = -hl To hl
    
29.         If brr(i, j) <> "" Then m = m + 1: crr(k, m) = brr(i, j)
    
30.     Next j
    
31.     If m <> 0 Then k = k + 1
    
32.     m = 0
    
33. Next i
    
34. If ro = 0 Or col = 0 Then XuanZhuan = crr Else XuanZhuan = crr(ro, col)
    
35. End Function

复制代码

aoe1981

　　截图及疑问如下：
　　

aoe1981

参数说明：=XuanZhuan(原始数据区域，旋转角度，行索引，列索引)
其中：旋转角度支持：90、180、270度，当然不需要0或360度……你懂的……
　　　行索引与列索引可以省略，省略其中一个或全部时，以数组形式输出结果，缺点是要提前判断输出矩形大小，否则，要么数据不全，要么会有错误值出现……你懂的……
　　　如果不省略，则输出由行与列的值确定的结果数组中的对应一个值。
　　呵呵……

aoe1981

在2楼第5行代码前插入以下语句，可以防止数据区域为一个单元格时的错误：

1. If rng.Count = 1 Then XuanZhuan = rng.Value: Exit Function
   

复制代码

aoe1981

另外，TRANSPOSE()函数其实与旋转无关，它的本质应当是对称变换……待对称变换自定义函数做出后再行验证……

aoe1981

关于矩形区域对称变换的直观可视化参考见下帖：
http://club.excelhome.net/forum. ... 867&pid=7878843

aoe1981

　　正式版：
　　 旋转与对称变换自定义函数（正式版）.rar (22.22 KB, 下载次数: 66)

2014-10-4 16:20 上传

点击文件名下载附件

　　（更新时间：2014－10－04　16：19）

　　23楼提出的问题已解决，附件已更新：
　　http://club.excelhome.net/forum. ... 1156193&pid=7879480

aoe1981

　　旋转与对称分写函数代码：

1. Option Explicit
   
2. Public Function XuanZhuan(rng As Range, jd%, Optional ro% = 0, Optional col% = 0)
   
3. If jd <> 90 And jd <> 180 And jd <> 270 Then XuanZhuan = "旋转角度取值应为：90、180、270度！": Exit Function
   
4. Dim arr, h%, l%, i%, j%, hl%, x!, y!, hd#, h1%, l1%, m%, k%
   
5. If rng.Count = 1 Then XuanZhuan = rng.Value: Exit Function
   
6. arr = rng.Value '原始数据数组
   
7. h = UBound(arr): l = UBound(arr, 2)
   
8. If jd = 90 Then jd = 270 Else If jd = 270 Then jd = 90 '工作表其实是第四象限，相当于转为第一象限
   
9. hl = WorksheetFunction.Max(h, l): hd = jd / 180 * Application.Pi()
   
10. ReDim brr(-hl To hl, -hl To hl) '过渡数组
    
11. For i = 1 To h '对应y
    
12.     For j = 1 To l '对应x
    
13.         x = j * Cos(hd) - i * Sin(hd)
    
14.         y = j * Sin(hd) + i * Cos(hd)
    
15.         brr(y, x) = arr(i, j)
    
16.     Next j
    
17. Next i
    
18. h1 = 0: l1 = 0
    
19. For i = -hl To hl '非空列
    
20.     m = 0
    
21.     For j = -hl To hl
    
22.         If brr(i, j) <> "" Then m = m + 1
    
23.     Next j
    
24.     If l1 < m Then l1 = m
    
25. Next i
    
26. If l1 = l Then h1 = h Else h1 = l '非空行
    
27. ReDim crr(1 To h1, 1 To l1)
    
28. m = 0: k = 1
    
29. For i = -hl To hl '剔除brr中的空值，保留非空值位置
    
30.     For j = -hl To hl
    
31.         If brr(i, j) <> "" Then m = m + 1: crr(k, m) = brr(i, j)
    
32.     Next j
    
33.     If m <> 0 Then k = k + 1
    
34.     m = 0
    
35. Next i
    
36. If ro = 0 Or col = 0 Then XuanZhuan = crr Else XuanZhuan = crr(ro, col)
    
37. End Function
    
38. Public Function DuiChen(rng As Range, jd%, Optional ro% = 0, Optional col% = 0)
    
39. If jd <> 45 And jd <> 90 And jd <> 135 And jd <> 180 Then DuiChen = "对称轴角度取值应为：45、90、135、180度！": Exit Function
    
40. Dim arr, h%, l%, i%, j%, hl%, x!, y!, hd#, h1%, l1%, m%, k%
    
41. If rng.Count = 1 Then DuiChen = rng.Value: Exit Function
    
42. arr = rng.Value '原始数据数组
    
43. h = UBound(arr): l = UBound(arr, 2)
    
44. If jd = 45 Then jd = 135 Else If jd = 135 Then jd = 45 '工作表其实是第四象限，相当于转为第一象限
    
45. hl = WorksheetFunction.Max(h, l): hd = jd / 180 * Application.Pi()
    
46. ReDim brr(-hl To hl, -hl To hl) '过渡数组
    
47. For i = 1 To h '对应y
    
48.     For j = 1 To l '对应x
    
49.         x = j * Cos(hd * 2) + i * Sin(hd * 2)
    
50.         y = j * Sin(hd * 2) - i * Cos(hd * 2)
    
51.         brr(y, x) = arr(i, j)
    
52.     Next j
    
53. Next i
    
54. h1 = 0: l1 = 0
    
55. For i = -hl To hl '非空列
    
56.     m = 0
    
57.     For j = -hl To hl
    
58.         If brr(i, j) <> "" Then m = m + 1
    
59.     Next j
    
60.     If l1 < m Then l1 = m
    
61. Next i
    
62. If l1 = l Then h1 = h Else h1 = l '非空行
    
63. ReDim crr(1 To h1, 1 To l1)
    
64. m = 0: k = 1
    
65. For i = -hl To hl '剔除brr中的空值，保留非空值位置
    
66.     For j = -hl To hl
    
67.         If brr(i, j) <> "" Then m = m + 1: crr(k, m) = brr(i, j)
    
68.     Next j
    
69.     If m <> 0 Then k = k + 1
    
70.     m = 0
    
71. Next i
    
72. If ro = 0 Or col = 0 Then DuiChen = crr Else DuiChen = crr(ro, col)
    
73. End Function
    

复制代码

aoe1981

　　旋转与对称合写函数“变换”代码：

1. Option Explicit
   
2. Public Function BianHuan(rng As Range, jd%, Optional n% = 1, Optional ro% = 0, Optional col% = 0)
   
3. If n = 1 And jd <> 90 And jd <> 180 And jd <> 270 Then BianHuan = "旋转角度取值应为：90、180、270度！": Exit Function
   
4. If n = 2 And jd <> 45 And jd <> 90 And jd <> 135 And jd <> 180 Then BianHuan = "对称轴角度取值应为：45、90、135、180度！": Exit Function
   
5. If n <> 1 And n <> 2 Then BianHuan = "变换类型1为旋转，2为对称！": Exit Function
   
6. Dim arr, h%, l%, i%, j%, hl%, x!, y!, hd#, h1%, l1%, m%, k%
   
7. If rng.Count = 1 Then BianHuan = rng.Value: Exit Function
   
8. arr = rng.Value '原始数据数组
   
9. h = UBound(arr): l = UBound(arr, 2)
   
10. If n = 1 Then
    
11.     If jd = 90 Then jd = 270 Else If jd = 270 Then jd = 90 '工作表其实是第四象限，相当于转为第一象限
    
12. ElseIf n = 2 Then
    
13.     If jd = 45 Then jd = 135 Else If jd = 135 Then jd = 45 '工作表其实是第四象限，相当于转为第一象限
    
14. End If
    
15. hl = WorksheetFunction.Max(h, l): hd = jd / 180 * Application.Pi()
    
16. ReDim brr(-hl To hl, -hl To hl) '过渡数组
    
17. For i = 1 To h '对应y
    
18.     For j = 1 To l '对应x
    
19.         If n = 1 Then
    
20.             x = j * Cos(hd) - i * Sin(hd)
    
21.             y = j * Sin(hd) + i * Cos(hd)
    
22.             brr(y, x) = arr(i, j)
    
23.         ElseIf n = 2 Then
    
24.             x = j * Cos(hd * 2) + i * Sin(hd * 2)
    
25.             y = j * Sin(hd * 2) - i * Cos(hd * 2)
    
26.             brr(y, x) = arr(i, j)
    
27.         End If
    
28.     Next j
    
29. Next i
    
30. h1 = 0: l1 = 0
    
31. For i = -hl To hl '非空列
    
32.     m = 0
    
33.     For j = -hl To hl
    
34.         If brr(i, j) <> "" Then m = m + 1
    
35.     Next j
    
36.     If l1 < m Then l1 = m
    
37. Next i
    
38. If l1 = l Then h1 = h Else h1 = l '非空行
    
39. ReDim crr(1 To h1, 1 To l1)
    
40. m = 0: k = 1
    
41. For i = -hl To hl '剔除brr中的空值，保留非空值位置
    
42.     For j = -hl To hl
    
43.         If brr(i, j) <> "" Then m = m + 1: crr(k, m) = brr(i, j)
    
44.     Next j
    
45.     If m <> 0 Then k = k + 1
    
46.     m = 0
    
47. Next i
    
48. If ro = 0 Or col = 0 Then BianHuan = crr Else BianHuan = crr(ro, col)
    
49. End Function
    

复制代码