VBA提取

好多好多栁髅怀

VBA难吗，不懂英文可以学吗，求助下看看怎么写代码，谢谢了

user湫

Excel函数就可以解决

kuangben8

1. =FILTER(表1!A1:A6000,ISNUMBER(FIND(RIGHT(表1!A1:A6000),"TW"))*(表1!B1:B6000>0),"")

复制代码

kuangben8

1. Sub Filter()
   
2.     Dim arr
   
3.     Dim brr()
   
4.     Dim m%, n%
   
5.     With Worksheets("表1")
   
6.         arr = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr))
   
9.     For m = 1 To UBound(arr)
   
10.         If (Right(arr(m, 1), 1) = "T" Or Right(arr(m, 1), 1) = "W") And arr(m, 2) > 0 Then
    
11.             n = n + 1
    
12.             brr(n) = arr(m, 1)
    
13.         End If
    
14.     Next
    
15.     ReDim Preserve brr(1 To n)
    
16.     Application.ScreenUpdating = False
    
17.     With Worksheets("表2")
    
18.         .Range("A2").CurrentRegion.Offset(1).ClearContents
    
19.         .Range("A2").Resize(UBound(brr), 1).Value = WorksheetFunction.Transpose(brr)
    
20.     End With
    
21.     Application.ScreenUpdating = True
    
22. End Sub

复制代码

kuangben8

VBA提取.zip (38.11 KB, 下载次数: 5)

2024-7-5 23:11 上传

点击文件名下载附件

好多好多栁髅怀

kuangben8 发表于 2024-7-5 23:11

哥，那要是找到后想把A和B列都体现出来要怎么改代码呢

好多好多栁髅怀

kuangben8 发表于 2024-7-5 23:11

哥还有提取出来的数据怎么排序好在放在表2呢，这VBA不好学呀，英文不好记不住啊，函数稍微简单点，哎不好学了

kuangben8

好多好多栁髅怀 发表于 2024-7-7 01:02
哥，那要是找到后想把A和B列都体现出来要怎么改代码呢

1. Sub Filter2()
   
2.     Dim arr
   
3.     Dim brr()
   
4.     Dim m%, n%
   
5.     With Worksheets("表1")
   
6.         arr = .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
   
7.     End With
   
8.     ReDim brr(1 To UBound(arr), 1 To 2)
   
9.     For m = 1 To UBound(arr)
   
10.         If (Right(arr(m, 1), 1) = "T" Or Right(arr(m, 1), 1) = "W") And arr(m, 2) > 0 Then
    
11.             n = n + 1
    
12.             brr(n, 1) = arr(m, 1)
    
13.             brr(n, 2) = arr(m, 2)
    
14.         End If
    
15.     Next
    
16. '    ReDim Preserve brr(1 To n)
    
17.     Application.ScreenUpdating = False
    
18.     With Worksheets("表2")
    
19.         .Range("A2").CurrentRegion.Offset(1).ClearContents
    
20.         .Range("A2").Resize(n, 2).Value = brr
    
21.     End With
    
22.     Application.ScreenUpdating = True
    
23. End Sub

复制代码

A、B两列都显示的代码

kuangben8

A、B两列都显示的代码。想要排序的依据是什么？
VBA提取.zip (38.28 KB, 下载次数: 4)

2024-7-7 18:56 上传

点击文件名下载附件

好多好多栁髅怀

kuangben8 发表于 2024-7-7 18:56
A、B两列都显示的代码。想要排序的依据是什么？

哥前20位一样的排序在一起，最后一位是T的放第一位就可以，这VBA有点不好懂