[求助]帮忙修改”VBA筛选非重复值方法比较“代码

nbchn

VBA筛选非重复值方法比较

作者：UNARTHUR
'网页：http://club.excelhome.net/viewthread.php?tid=104741&replyID=&skin=0

代码如下：

Sub 按钮1_单击() '这种方法最快
'Application.ScreenUpdating = False
t = Timer
Dim i&, j&, k&, p&, rng, rng1, ary()
Dim arr As Range
[g:g].ClearContents                      '清除所在页面G列的值,

'为什么g:g不能修改，如：g2:g,g3:g.....

p = [出入库登记!c60036].End(xlUp).Row     '定义数据区域的最后一行65536
Set arr = Range("出入库登记!c1:c" & p)

'为什么c1:c不能修改，如：c2:c,c3:c.....
ReDim ary(1 To p, 0)
rng = arr
arr.Sort Key1:=arr(1, 1), Order1:=xlAscending, Header:=xlNo
rng1 = arr
arr = rng
ary(1, 0) = rng1(1, 1)
For i = 2 To p
   If rng1(i, 1) <> rng1(i - 1, 1) Then
      ary(k + 2, 0) = rng1(i, 1)
      k = k + 1
   End If
Next i
Range("总结!g1:g" & p) = ary              '不重复值放置的区域

'为什么g1不能修改，如：g2,g3.....

t1 = Timer - t
MsgBox "用时：" & t1 & "秒"
Application.ScreenUpdating = True
End Sub

因表格有表头，所以想修改以上两处g:g和g1:g

为什么每次运行完程序后，自动计算设置变成了手动计算？

请高手们指教！

[此贴子已经被作者于2008-8-20 12:36:03编辑过]

fsyyyy

1、[g2:g6] 都带上行数

2、g2:g" & p+1)或者g3:g" & p+2) 区域应与arr匹配

nbchn

可以了，谢谢，

1、[g2:g6] 都带上行数--G列的最后一行是GX，可不可以改为[g2:gX]

为什么没人回答第2、4个问题？

急急

[此贴子已经被作者于2008-8-20 12:56:25编辑过]

shizx98

1，把'Application.ScreenUpdating = False
前面的'删除；

2，可以改为Range("g2:g"& x)，但是有关的都要改

nbchn

原代码

vM6cWPo3.rar (97.22 KB, 下载次数: 17)

2008-8-20 13:32 上传

点击文件名下载附件
[求助]帮忙修改”VBA筛选非重复值方法比较“代码

第4问已解决了!

' Application.Calculation = xlCalculationManual       '手动重算

将上句前加'，增加下句

Application.Calculation = xlCalculationAutomatic    '自动重算

 请高手把第2个问题也解决一下！！！

[此贴子已经被作者于2008-8-20 14:45:35编辑过]

shizx98

Sub 库存物品统计按钮() '这种方法最快
Application.ScreenUpdating = False
t = Timer
Dim i&, j&, k&, p&, rng, rng1, ary()
Dim arr As Range
p = [出入库登记!c65536].End(xlUp).row     '定义数据区域的最后一行行号65536
Set arr = Range("出入库登记!c4:c" & p)    '取不重复值表开始的位置,列号可以改，行号还不行
ReDim ary(1 To p, 0)
rng = arr
arr.Sort Key1:=arr(1, 1), Order1:=xlAscending, Header:=xlNo
rng1 = arr
arr = rng
ary(1, 0) = rng1(1, 1)
For i = 2 To p - 3
   If rng1(i, 1) <> rng1(i - 1, 1) Then
      ary(k + 2, 0) = rng1(i, 1)
      k = k + 1
   End If
Next i
Range("库存!a4:a" & p + 3) = ary  

再下面的代码不对了。

nbchn

感谢shizx98老师

运行后显示错误，如图：

山菊花

改这一句试试：

Set arr = Sheets("出入库登记").Range("c4:c" & p)   '取不重复值表开始的位置,列号可以改，行号还不行

nbchn

山老师，还是不行！

 

山菊花

我在测试中未发现错误。