求助如何 通过vba实现条件提取

wenbai0626

quqiyuan 发表于 2024-5-8 07:45

感谢老师，有个小问题，如果我在数据源里面新插一列，怎么筛选出来也是插入后的所有的符合条件的最新的数据呢

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.8
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("条件数据")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 1)
   
6.     End With
   
7.     For i = 2 To UBound(arr)
   
8.         s = CStr(arr(i, 1))
   
9.         d(s) = ""
   
10.     Next
    
11.     With Sheets("数据源")
    
12.         r = .Cells(Rows.Count, 1).End(3).Row
    
13.         arr = .[a1].Resize(r, 4)
    
14.     End With
    
15.     ReDim brr(1 To r, 1 To 4)
    
16.     For i = 2 To UBound(arr)
    
17.         s = CStr(arr(i, 4))
    
18.         If d.exists(s) Then
    
19.             m = m + 1
    
20.             For j = 1 To UBound(arr, 2)
    
21.                 brr(m, j) = arr(i, j)
    
22.             Next
    
23.         End If
    
24.     Next
    
25.     With Sheets("结果表")
    
26.         .UsedRange.Offset(1).ClearContents
    
27.         .Columns(4).NumberFormatLocal = "@"
    
28.         .[a2].Resize(m, 4) = brr
    
29.         .[a2].Resize(m, 4).Borders.LineStyle = 1
    
30.     End With
    
31.     Set d = Nothing
    
32.     MsgBox "OK！"
    
33. End Sub
    

复制代码

yaofengda

py参与一下

limonet

wenbai0626 发表于 2024-5-8 08:45
感谢老师，有个小问题，如果我在数据源里面插一列，怎么筛选出来也是插入后的所有的符合条件的数据呢

插在前，筛在后，那肯定会获取到啊，有什么问题？

saghj

交个作业

quqiyuan

wenbai0626 发表于 2024-5-8 08:46
感谢老师，有个小问题，如果我在数据源里面新插一列，怎么筛选出来也是插入后的所有的符合条件的最新的数 ...

不是很明白你的意思，我这个是比对数据源的第4列的数据的

cyq4896

Sub test()
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("条件数据")
        arr = .[a1].CurrentRegion
        For i = 2 To UBound(arr)
            dic(arr(i, 1)) = i
        Next
    End With
    With Sheets("数据源")
        arr = .[a1].CurrentRegion
    End With
    ReDim brr(1 To UBound(arr), 1 To 4)
    For i = 2 To UBound(arr)
        If dic.exists(arr(i, 4)) Then
            m = m + 1
            For j = 1 To 4
                brr(m, j) = arr(i, j)
            Next
        End If
    Next
    With Sheets("结果表")
        .UsedRange.Offset(1).ClearContents
        .Columns(4).NumberFormatLocal = "@"
        .Cells(2, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
End Sub

cyq4896

参与一下..

wenbai0626

quqiyuan 发表于 2024-5-8 09:58
不是很明白你的意思，我这个是比对数据源的第4列的数据的

就是我在数据源里面新插入一列，也想结果表里面也能把新加的这一列加进去，因为可能我的列数是不固定的，所以想请教下有没有可以根据我的列数自动添加把新增或者修改的也同步到结果表里面