自定义函数：区域内非空单元格按先行后列顺序排列为一维数组

makelot

问题见示意图和附件，希望高手帮助，多谢！

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, m, brr()
  arr = [d4:h9].Value
  ReDim brr(1 To UBound(arr, 1) * UBound(arr, 2))
  For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
      If Len(arr(i, j)) Then m = m + 1: brr(m) = arr(i, j)
    Next
  Next
  ReDim Preserve brr(1 To m)
  MsgBox Join(brr, vbNewLine)
End Sub

cui26896

请注意，用公式必须是数组的输入方法（按三键），如果一行中有两个以上非空单元格，输入最后的单行数组元素必须与非空单元格的总数相等，否则，会出错！你要用excel公式，这都是规矩，必须尊守！

自定义函数：区域内非空单元格按先行后列顺序排列为一维数组.zip (13.77 KB, 下载次数: 0)

2020-2-20 21:12 上传

点击文件名下载附件

cui26896

又要审核，无法，先上图片

makelot

一把小刀闯天下 发表于 2020-2-20 20:51
Option Explicit

Sub test()

谢谢！我还以为很复杂呢，原来这么简单就解决了。高手就是高手，非常感谢！

makelot

cui26896 发表于 2020-2-20 21:18
又要审核，无法，先上图片

谢谢！刚才测试了以下，好像还不完善。下来我修改一下，多谢！

cui26896

没有，我的附件和原帖还在审核，我做了说明了，你必须保证象在excel表格那样去用公式，而且是象用数组公式那样去用，三键同按，否则是不行的。还有，如果你每一行非空单元格不止一个，有多个，在要输出数组的这一行，必须保证增加元素保证这一行要输出数组的单元格个数与区域的不为空的单元格总个数相等。

cui26896

先发附件吧，不然要审核到什么时候啊！
自定义函数：区域内非空单元格按先行后列顺序排列为一维数组.zip (13.77 KB, 下载次数: 7)

2020-2-20 22:58 上传

点击文件名下载附件

makelot

cui26896 发表于 2020-2-20 22:56
没有，我的附件和原帖还在审核，我做了说明了，你必须保证象在excel表格那样去用公式，而且是象用数组公式 ...

谢谢！工作表内使用数组公式我知道，刚才又测试了一下您的程序，还是不完善，您多填几个数就发现了。
代码我修改了一下，随后贴出来，非常感谢！

makelot

非常感谢 一把小刀闯天下 和 cui26896 两位网友的帮助！函数代码我完善了一下，如下：

1. Function Sort1Dim(rng As Range) As Variant '区域非空单元格数据按先行后列的位置排序，输出到一维数组
   
2.     Dim arr, brr, r%, c%, i%, j%, k%
   
3.     arr = rng
   
4.     r = UBound(arr, 1): c = UBound(arr, 2)
   
5.     ReDim brr(1 To r * c)
   
6.     For i = 1 To r
   
7.         For j = 1 To c
   
8.             If Len(arr(i, j)) Then k = k + 1: brr(k) = arr(i, j)
   
9.         Next
   
10.     Next
    
11.     ReDim Preserve brr(1 To k)
    
12.     Sort1Dim = brr
    
13. End Function

复制代码