修改和完善数据倒置的代码

WYS67

原代码：
Function DAOZHI(rng As Range) As Variant
    Dim arr, i&, j&, k&, arr1
    arr = rng
    ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2))
    k = 0
    For i = UBound(arr) To 1 Step -1
        k = k + 1
        For j = 1 To UBound(arr, 2)
            arr1(k, j) = arr(i, j)
        Next
    Next
    DAOZHI = arr1
End Function


上边是数据倒置的自定义函数代码。当数据源A5:A1000的上边、中间和下边有空格存在时，就如C5:C1000显示的那样，中间多了许多“0”.

  而我想要实现如B5:B1000的显示效果：忽略指定数据源区域A5:A1000上边、中间和下方的空格，只对不空的单元格倒置。请老师们帮忙修改和完善上面的代码。

修改和完善数据倒置的代码.zip (19.17 KB, 下载次数: 17)

2018-12-3 22:12 上传

点击文件名下载附件

yjh_27

加if
Function DAOZHI(rng As Range) As Variant
    Dim arr, i&, j&, k&, arr1
    arr = rng
    ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2))
    k = 0
    For i = UBound(arr) To 1 Step -1
        if arr(i, 1)<>"" then
                k = k + 1
        For j = 1 To UBound(arr, 2)
            arr1(k, j) = arr(i, j)
        Next
        endif
    Next
    DAOZHI = arr1
End Function

WYS67

yjh_27 发表于 2018-12-3 22:23
加if
Function DAOZHI(rng As Range) As Variant
    Dim arr, i&, j&, k&, arr1

？？？

清风竹-

1. Function DAOZHI(rng As Range) As Variant
   
2.     Dim arr, i&, j&, k&, arr1
   
3.     arr = Range(Cells(5, 1), Cells(65536, 1).End(3))
   
4.     ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     k = 0
   
6.     For i = UBound(arr) To 1 Step -1
   
7.       If arr(i, 1) <> "" Then
   
8.         k = k + 1
   
9.         For j = 1 To UBound(arr, 2)
   
10.             arr1(k, j) = arr(i, j)
    
11.         Next
    
12.         
    
13.        End If
    
14.     Next
    
15.     DAOZHI = arr1
    
16. End Function
    

复制代码

lsc900707

1. Function DAOZHI(rng As Range) As Variant
   
2.     Dim arr, i&, j&, k&, arr1
   
3.     arr = Range(Cells(5, 1), Cells(65536, 1).End(3))
   
4.     ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     k = 0
   
6.     For i = UBound(arr) To 1 Step -1
   
7.       If len(arr(i, 1)) Then
   
8.         k = k + 1
   
9.         For j = 1 To UBound(arr, 2)
   
10.             arr1(k, j) = arr(i, j)
    
11.         Next
    
12.        End If
    
13.     Next
    
14.     DAOZHI = arr1
    
15. End Function
    

复制代码

WYS67

清风竹- 发表于 2018-12-3 22:29

公式在C列，麻烦老师在代码里屏蔽C15以下因为没有数据而显示的“0”和#N/A错误。

WYS67

lsc900707 发表于 2018-12-3 22:29

好久不见！感谢版主老师的热心帮忙！代码计算结果出现和6楼一样的问题：C15以下因为没有数据而显示的“0”和#N/A错误，麻烦老师屏蔽多余的“0”和#N/A为空白。

WYS67

lsc900707 发表于 2018-12-3 22:29

公式在C列，麻烦老师在代码里屏蔽C15以下因为没有数据而显示的“0”和#N/A错误

WYS67

yjh_27 发表于 2018-12-3 22:23
加if
Function DAOZHI(rng As Range) As Variant
    Dim arr, i&, j&, k&, arr1

老师：截图C列是用您写的代码计算显示的结果，怎样屏蔽C15以下多余的“0”和#N/A错误为空白？麻烦您加以修改。

修改和完善数据倒置的代码.zip (19.32 KB, 下载次数: 6)

2018-12-3 23:07 上传

点击文件名下载附件

清风竹-

WYS67 发表于 2018-12-3 22:36
公式在C列，麻烦老师在代码里屏蔽C15以下因为没有数据而显示的“0”和#N/A错误。

1. Function DAOZHI(rng As Range) As Variant
   
2.     Dim arr, i&, j&, k&, arr1
   
3.     arr = Range(Cells(5, 1), Cells(65536, 1).End(3))
   
4.     ReDim arr1(1 To 1000, 1 To 1)
   
5.     k = 0
   
6.     For i = UBound(arr) To 1 Step -1
   
7.       If arr(i, 1) <> "" Then
   
8.         k = k + 1
   
9.             arr1(k, 1) = arr(i, 1)
   
10.        End If
    
11.     Next
    
12.      For i = k + 1 To 1000
    
13.          arr1(i, 1) = ""
    
14.      Next
    
15.     DAOZHI = arr1
    
16. End Function

复制代码