[求助]如何在数组里删除行

xiangchendub · 发表于 2005-12-29 09:56

各位大侠请教一个问题：我想在2维数组里实现自动筛选的功能，不知如何实现。在有就是如何在数组里删除没用的行。不知各位能不能给点思路或例子谢谢

xiangchendub · 发表于 2005-12-29 12:05

我试了redim preserve arr(.,.)

不行。

Long_III · 发表于 2005-12-29 12:33

我想在2维数组里实现自动筛选的功能，不知如何实现？

不可以！

“在有就是如何在数组里删除没用的行。”，也不行，简洁处理方法就是，重新定义一个数组，取出原数组里符合条件的行

xiangchendub · 发表于 2005-12-29 15:34

哈，龙兄终于拔刀了。谢了。

我想在2维数组里实现自动筛选的功能，不知如何实现？

不可以！

可能我没有表达清楚。我不是要在数组里用autofilter, 我只是想在数组里实现类似autofilter + delete rows 的功能。简单的说就是，把工作表的一个区域赋值给一个数组，在数组里选出符合条件的行删掉，再把数组里剩余的行赋值给工作表的一个区域。

我本来的思路是：在数组里做个loop,把不符合条件的放到最前边的若干行里，（这点我能做到）再把下边的剩余行redim 掉，由于redim preserve只能改变列维（对于2维来说），我就transpose 一下再redim preserve，但是仍然未遂。本来想不调用2 个数组，速度会快一点。不知道这个思路能行不？

“在有就是如何在数组里删除没用的行。”，也不行，简洁处理方法就是，重新定义一个数组，取出原数组里符合条件的行

如果说只能新建一个数组来提取不符合条件的行的话，那末是不是只能从原来的数组里一个一个的元素提取，而不能整行的提。

龙兄以往的帖子向来都很有启发性，再次感谢。

Long_III · 发表于 2005-12-29 17:26

给你一个示例看看吧 Sub hjs() Dim arr, Xarr() Dim i%, m% arr = Range("a1:c15") For i = 1 To 15 If i = 1 Or arr(i, 1) = "A" Then m = m + 1 ReDim Preserve Xarr(1 To 3, 1 To m) For j = 1 To 3 Xarr(j, m) = arr(i, j) Next End If Next [e1].Resize(m, 3) = Application.WorksheetFunction.Transpose(Xarr) End Sub

sV17zdAT.rar (8.61 KB, 下载次数: 212)

xiangchendub · 发表于 2005-12-29 18:36

big help, million thanks

上边的例子非常好，就一点：当矩阵元素超过 5160 时，transpose function fails.

也就是说，在上边的例子中，A 列为“A"的行超过1820时，就报错了。

一点点遗憾。。。。

xiangchendub · 发表于 2005-12-29 18:46

BTW, 我用的excel 2000, 不知道在2003中，transpose 的上限有没有提高。那位热心的朋友帮忙测一下。

谢谢

guangzhao17 · 发表于 2016-12-17 14:25

Option Base 1
Sub 数组删行()

Dim arr(), arrtemp(), arrhang(), arrquan()
Dim m As Integer, n As Integer
m = 0
n = 0
arr = Application.Transpose(Range("表8[商品名称]").Value) '这里的range是含空值的某列。

For i = 1 To UBound(arr)

If arr(i) <> "" Then
'm = m + 1
'ReDim Preserve arrtemp(m)
'arrtemp(m) = arr(i)

n = n + 1
ReDim Preserve arrhang(n)
arrhang(n) = i
End If

Next

arrquan() = Range("表8")
Dim arrhou
ReDim arrhou(UBound(arrhang), UBound(arrquan))

For i = 1 To UBound(arrhang)
For j = 1 To UBound(arrquan, 2)
arrhou(i, j) = arrquan(arrhang(i), j) 'arrhou是删除了空行以后的新数组。
Next
Next
range("表8").clear '清空内容
Cells(4, 1).Resize(UBound(arrhou, 1), UBound(arrhou, 2)) = arrhou '重新赋值区域

End Sub

		自动登录	找回密码
密码			免费注册