|
楼主 |
发表于 2014-8-21 17:15
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
以下为自定义函数:
附件为使用例子。(也可用于VBA内存数组的转换)- Function JoinTurnArr(Rng_Arr, k&, Optional z& = 0) 'k=4/5,3/6,2/7,1/8
- Dim i&, j&, l1&, l2&, u1&, u2&, r&, s$, t&
- If IsObject(Rng_Arr) Then arr = Rng_Arr.Value Else arr = Rng_Arr
- l1 = LBound(arr): u1 = UBound(arr): l2 = LBound(arr, 2): u2 = UBound(arr, 2)
- If z Then
- s = ""
- If k Mod 2 Then
- For j = l2 To u2
- For i = l1 To u1
- r = r + 1
- If k = 5 Then t = arr(i, j) 'adcb OK
- If k = 3 Then t = arr(i, u2 - j + l2) 'bcda OK
- If k = 7 Then t = arr(u1 - i + l1, u2 - j + l2) 'cbad OK
- If k = 1 Then t = arr(u1 - i + l1, j) 'dabc OK
- If t Then s = s & "," & r
- Next
- Next
- Else
- For i = l1 To u1
- For j = l2 To u2
- r = r + 1
- If k = 4 Then t = arr(i, j) 'abcd OK
- If k = 6 Then t = arr(i, u2 - j + l2) 'badc OK
- If k = 2 Then t = arr(u1 - i + l1, u2 - j + l2) 'cdab OK
- If k = 8 Then t = arr(u1 - i + l1, j) 'dcba OK
- If t Then s = s & "," & r
- Next
- Next
- End If
- JoinTurnArr = Mid(s, 2)
- Else
- If k = 4 Then JoinTurnArr = arr: Exit Function
- If k Mod 2 Then ReDim trr(l2 To u2, l1 To u1) Else ReDim trr(l1 To u1, l2 To u2)
- For i = l1 To u1
- For j = l2 To u2
- ' If k = 4 Then trr(i, j) = arr(i, j) 'abcd OK
- If k = 5 Then trr(j, i) = arr(i, j) 'adcb OK
-
- If k = 3 Then trr(u2 - j + l2, i) = arr(i, j) 'bcda OK
- If k = 6 Then trr(i, u2 - j + l2) = arr(i, j) 'badc OK
-
- If k = 2 Then trr(u1 - i + l1, u2 - j + l2) = arr(i, j) 'cdab OK
- If k = 7 Then trr(u2 - j + l2, u1 - i + l1) = arr(i, j) 'cbad OK
-
- If k = 1 Then trr(j, u1 - i + l1) = arr(i, j) 'dabc OK
- If k = 8 Then trr(u1 - i + l1, j) = arr(i, j) 'dcba OK
- Next
- Next
- JoinTurnArr = trr
- End If
- End Function
复制代码 |
|