提取不同字符

嘎嘎东方大道

把"表1"“A2-B列”不含QQ字符的表格复制到“表2”G2-H列（原来有数据的则跳到数据的最后一个空值黏贴），不重复提取。

taller

taller

张劲松2024

版主牛！！！！！！！！！！！！！！！！！！！！！

嘎嘎东方大道

taller 发表于 2024-6-16 01:10

老师，运行VBA后怎么变成自动保存了？可以只提取数据不执行其他操作吗。

taller

嘎嘎东方大道 发表于 2024-6-16 11:12
老师，运行VBA后怎么变成自动保存了？可以只提取数据不执行其他操作吗。

去掉最后两行Close语句

嘎嘎东方大道

taller 发表于 2024-6-16 11:29
去掉最后两行Close语句

额，试过了不能把带QQ字符数据筛选，直接就是一模一样的复制过来

longwin

练习一下：

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.16
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     p = ThisWorkbook.Path
   
5.     f1 = p & "\1.xlsx"
   
6.     f2 = p & "\2.xlsx"
   
7.     ReDim brr(1 To 10000, 1 To 2)
   
8.     Set wb = Workbooks.Open(f1, 0)
   
9.     With wb.Sheets("Sheet1")
   
10.         arr = .UsedRange
    
11.         wb.Close False
    
12.     End With
    
13.     For i = 2 To UBound(arr)
    
14.         If InStr(arr(i, 1), "QQ") = 0 Then
    
15.             m = m + 1
    
16.             brr(m, 1) = arr(i, 1)
    
17.             brr(m, 2) = arr(i, 2)
    
18.         End If
    
19.     Next
    
20.     Set wb = Workbooks.Open(f2, 0)
    
21.     With wb.Sheets("Sheet1")
    
22.         .[g2:h1000] = ""
    
23.         .[g2].Resize(m, 2) = brr
    
24.         wb.Close 1
    
25.     End With
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    
29. 
    

复制代码