Excel·VBA螺旋数组函数 |
您所在的位置：网站首页 › vba如何使用excel函数 › Excel·VBA螺旋数组函数 |
Excel·VBA螺旋数组函数
|
目录
实现方法1代码思路螺旋数组函数举例
实现方法2代码思路螺旋数组函数
数字1-12从左上角顺时针依次输出的即为螺旋数组，如下图 从左上角开始，每一层按顶行、右列、底行、左列顺序依次赋值 代码思路以数字1-30为例 将一维数组转为二维螺旋数组 Function spiral(ByVal arr, ByVal num_rows&, ByVal num_cols&) '将一维数组转为二维螺旋数组，num_rows返回行数num_cols返回列数，大于1(数组从1开始计数) Dim i&, n&, w&, max_num&, max_n&, last_row&, last_col& '转为从1开始计数，检查参数num_rows、num_cols If LBound(arr) = 0 Then arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr)) If num_rows * num_cols UBound(arr) Then Debug.Print "参数错误": Exit Function Else max_num = UBound(arr): ReDim result(1 To num_rows, 1 To num_cols) End If '初始值，n当前写入层数，max_n最大层数 n = 1: max_n = WorksheetFunction.RoundUp(WorksheetFunction.Min(Array(num_rows, num_cols)) / 2, 0) last_row = num_rows - n + 1: last_col = num_cols - n + 1 Do For i = n To last_col - 1 '该层顶行 w = w + 1: result(n, i) = arr(w) Next For i = n To last_row - 1 '该层右列 w = w + 1: result(i, last_col) = arr(w) Next For i = last_col To n + 1 Step -1 '该层底行 w = w + 1: result(last_row, i) = arr(w) Next For i = last_row To n + 1 Step -1 '该层左列 w = w + 1: result(i, n) = arr(w) Next If n 0 Then step_n = -1 Else step_n = 1 ' If c > 0 Then c = c - step_n ' For i = 1 To max_c ' w = w + 1: c = c + step_n: result(r, c) = arr(w) ' Next ' mode_row = False ' Else '按列写入 ' If r = last_row Then step_n = -1 Else step_n = 1 ' c = c + step_n ' If r > 0 Then r = r - step_n ' For i = 1 To max_r ' w = w + 1: r = r + step_n: result(r, c) = arr(w) ' Next ' mode_row = True ' If r = x And step_n = -1 Then '每层循环结束后，更新值 ' x = x + 1: max_r = max_r - 2: max_c = max_c - 2 ' step_n = 1: last_row = last_row - 1 ' If max_r > 0 And max_c > 0 Then ' r = r - 1: c = c + 1 ' ElseIf max_r = 0 And max_c >= 0 Then ' max_c = max_c + 1: mode_row = True: r = r - 1: c = c + 1 ' ElseIf max_c = 0 And max_r > 0 Then ' max_r = max_r + 1: mode_row = False ' End If ' End If ' End If ' Loop Until w >= max_n ' spiral = result 'End Function Function spiral(ByVal arr, ByVal num_rows&, ByVal num_cols&) '将一维数组转为二维螺旋数组，num_rows返回行数num_cols返回列数，大于1(数组从1开始计数) Dim r&, c&, w&, mode_row As Boolean, max_n&, max_r&, max_c&, step_n&, last_row&, x&, n& '转为从1开始计数，检查参数num_rows、num_cols If LBound(arr) = 0 Then arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr)) If num_rows * num_cols UBound(arr) Then Debug.Print "参数错误": Exit Function Else max_n = UBound(arr): ReDim result(1 To num_rows, 1 To num_cols) End If '初始值，先按行写入；max_r和max_c都为当前行列数-1 r = 0: c = 0: max_r = num_rows - 1: max_c = num_cols - 1: step_n = 1 step_arr = Array(, 1, 1, -1, -1) mode_row = True: last_row = num_rows: x = 2 '最外层循环结束时的行号为2，次外层为3，以此类推 Do If mode_row = True Then '按行写入 r = r + step_n: n = n + 1: step_n = step_arr(n) If c > 0 Then c = c - step_n For i = 1 To max_c w = w + 1: c = c + step_n: result(r, c) = arr(w) Next mode_row = False Else '按列写入 n = n + 1: step_n = step_arr(n): c = c + step_n If r > 0 Then r = r - step_n For i = 1 To max_r w = w + 1: r = r + step_n: result(r, c) = arr(w) Next mode_row = True If r = x And step_n = -1 Then '每层循环结束后，更新值 x = x + 1: max_r = max_r - 2: max_c = max_c - 2 n = 0: step_n = 1: last_row = last_row - 1 If max_r > 0 And max_c > 0 Then r = r - 1: c = c + 1 ElseIf max_r = 0 And max_c >= 0 Then '都=0，即返回正方形奇数数组 max_c = max_c + 1: mode_row = True: r = r - 1: c = c + 1 ElseIf max_c = 0 And max_r > 0 Then max_r = max_r + 1: mode_row = False End If End If End If Loop Until w >= max_n spiral = result End Function测试结果与实现方法1一致 |
观察可知，每行依次填入该层列数-1个数字（上图黄色/绿色部分），同理每列依次填入该层行数-1个数字（上图无色部分）。在遍历每层时，顶行的行号和左列的列号等于层数，底行的行号和右列的列号随着层数的递增而递减，由此编写代码如下【本文地址】
今日新闻 |
推荐新闻 |