[已解决]明细数据筛选的问题，请坛里的大神帮忙！！！

js5 · 发表于 2012-10-17 11:58

请老师帮我写一个筛选代码，O(∩_∩)O谢谢！！！

明细数据筛选.rar (56.28 KB, 下载次数: 15)

2012-10-17 11:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

huoxieshen

2012-10-17 12:54

js5 发表于 2012-10-17 12:37
知道，备注里会存在其它的项目。
在筛选的时候我会注意输入筛选的内容。
请老师帮忙，O(∩_∩)O谢谢！！ ...

如果T4单元格的内容和你备注里的一模一样的话，向伟老师的就可以符合要求。。。如果要筛选出抵账和未抵账的，可以用下面的代码试试~~

Sub text()
Dim arr(), brr(1 To 60000, 1 To 9), i As Long, r As Long
With Sheets("明细数据")
r = .Cells(Rows.Count, 2).End(3).Row
arr = .Range("b5:t" & r).Value
End With
bz = Sheets("筛选表格").Range("t4").Value
For i = 1 To r - 4
If InStr(bz, "未") > 0 Then
If InStr(arr(i, 15), bz) Then
k = k + 1
brr(k, 1) = arr(i, 14)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
brr(k, 4) = arr(i, 4)
brr(k, 5) = arr(i, 9)
brr(k, 6) = arr(i, 17)
brr(k, 7) = arr(i, 8)
brr(k, 8) = arr(i, 10)
brr(k, 9) = arr(i, 15)
End If
Else
If InStr(arr(i, 15), bz) And InStr(arr(i, 15), "未") = 0 Then
k = k + 1
brr(k, 1) = arr(i, 14)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
brr(k, 4) = arr(i, 4)
brr(k, 5) = arr(i, 9)
brr(k, 6) = arr(i, 17)
brr(k, 7) = arr(i, 8)
brr(k, 8) = arr(i, 10)
brr(k, 9) = arr(i, 15)
End If
End If
Next
With Sheets("筛选表格")
.Range("l6:t65536").ClearContents
.Range("l6").Resize(k, 9) = brr
End With
End Sub

复制代码

跳转到最佳答案楼层

huoxieshen · 发表于 2012-10-17 12:09

备注里会出现哪几种状态，，退货未抵账，退货抵账，还有其它的么？？

huoxieshen · 发表于 2012-10-17 12:17

还有个问题，直接筛选抵账的话，会把退货抵账和退货未抵账都筛选进去。。所以这个需要问清楚

js5 · 发表于 2012-10-17 12:37

huoxieshen 发表于 2012-10-17 12:17
还有个问题，直接筛选抵账的话，会把退货抵账和退货未抵账都筛选进去。。所以这个需要问清楚

知道，备注里会存在其它的项目。
在筛选的时候我会注意输入筛选的内容。
请老师帮忙，O(∩_∩)O谢谢！！！

JLxiangwei · 发表于 2012-10-17 12:41

Sub test()
Dim arr, x, y, z, str, arr1(1 To 100000, 1 To 9)
arr = Sheet2.Range("b4:T" & Sheet2.Cells(Sheet2.Rows.Count, 2).End(xlUp).Row)
str = Sheet8.Range("T4")
For x = 1 To UBound(arr)
      If arr(x, 15) Like str Then
         y = y + 1
         arr1(y, 1) = arr(x, 14)
         arr1(y, 2) = arr(x, 2)
         arr1(y, 3) = arr(x, 3)
         arr1(y, 4) = arr(x, 4)
         arr1(y, 5) = arr(x, 9)
         arr1(y, 6) = arr(x, 6)
         arr1(y, 7) = arr(x, 8)
         arr1(y, 8) = arr(x, 10)
         arr1(y, 9) = arr(x, 15)
      End If
Next
Sheet8.Range("i5:t1000").ClearContents
Sheet8.Range("l5").Resize(y, 9) = arr1
End Sub

明细数据筛选.zip (22.23 KB, 下载次数: 13)

huoxieshen · 发表于 2012-10-17 12:54

这个最佳答案由 huoxieshen 给出，感谢 huoxieshen 的回答。

单击隐藏图章

js5 发表于 2012-10-17 12:37
知道，备注里会存在其它的项目。
在筛选的时候我会注意输入筛选的内容。
请老师帮忙，O(∩_∩)O谢谢！！ ...

如果T4单元格的内容和你备注里的一模一样的话，向伟老师的就可以符合要求。。。如果要筛选出抵账和未抵账的，可以用下面的代码试试~~

Sub text()
Dim arr(), brr(1 To 60000, 1 To 9), i As Long, r As Long
With Sheets("明细数据")
r = .Cells(Rows.Count, 2).End(3).Row
arr = .Range("b5:t" & r).Value
End With
bz = Sheets("筛选表格").Range("t4").Value
For i = 1 To r - 4
If InStr(bz, "未") > 0 Then
If InStr(arr(i, 15), bz) Then
k = k + 1
brr(k, 1) = arr(i, 14)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
brr(k, 4) = arr(i, 4)
brr(k, 5) = arr(i, 9)
brr(k, 6) = arr(i, 17)
brr(k, 7) = arr(i, 8)
brr(k, 8) = arr(i, 10)
brr(k, 9) = arr(i, 15)
End If
Else
If InStr(arr(i, 15), bz) And InStr(arr(i, 15), "未") = 0 Then
k = k + 1
brr(k, 1) = arr(i, 14)
brr(k, 2) = arr(i, 2)
brr(k, 3) = arr(i, 3)
brr(k, 4) = arr(i, 4)
brr(k, 5) = arr(i, 9)
brr(k, 6) = arr(i, 17)
brr(k, 7) = arr(i, 8)
brr(k, 8) = arr(i, 10)
brr(k, 9) = arr(i, 15)
End If
End If
Next
With Sheets("筛选表格")
.Range("l6:t65536").ClearContents
.Range("l6").Resize(k, 9) = brr
End With
End Sub

复制代码

js5 · 发表于 2012-10-17 13:22

JLxiangwei 发表于 2012-10-17 12:41
Sub test()
Dim arr, x, y, z, str, arr1(1 To 100000, 1 To 9)
arr = Sheet2.Range("b4:T" & Sh ...

谢谢伟老师帮忙，您写的代码不具有模糊筛选。不好意思，最佳答案不能给您。非常抱歉！！！

js5 · 发表于 2012-10-17 13:24

huoxieshen 发表于 2012-10-17 12:54
如果T4单元格的内容和你备注里的一模一样的话，向伟老师的就可以符合要求。。。如果要筛选出抵账和未抵账 ...

老师谢谢您的给我的帮助！！！

这就是我想要实现的功能，太感性您啦！！！{:28:}

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

[已解决]明细数据筛选的问题，请坛里的大神帮忙！！！

相关帖子