## 用户名 Email 自动登录 找回密码 密码 注册
 搜索
 数据透视表40+个常用小技巧，让你一次学会！

# 提取差异数 发表于 2022-6-20 17:10 | 显示全部楼层 |阅读模式
 提取差异数，请用VBA 6.3 KB, 下载次数: 5 发表于 2022-6-20 18:08 | 显示全部楼层 本帖最后由 sam-wang 于 2022-6-20 18:10 编辑 請測試看看，謝謝 Sub test() Dim Arr, xD, i&, n& Set xD = CreateObject("Scripting.Dictionary") Arr = Range("d1").CurrentRegion For i = 2 To UBound(Arr): xD(Arr(i, 2) & "") = 1: Next For i = 2 To UBound(Arr)     If xD(Arr(i, 1) & "") = 1 Then GoTo 99     n = n + 1: Arr(n, 1) = Arr(i, 1) 99: Next [h2].Resize(n, 1) = Arr End Sub  楼主| 发表于 2022-6-20 18:33 | 显示全部楼层
 sam-wang 发表于 2022-6-20 18:08 請測試看看，謝謝 Sub test() Dim Arr, xD, i&, n& 谢谢 发表于 2022-6-20 18:37 | 显示全部楼层
 Sub tt()   Dim Ar, Br, Cr(), X%, K%, Rg1, Rg2   With ActiveSheet    Set Rg1 = .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)    Set Rg2 = .Range("E2:E" & .Cells(Rows.Count, 5).End(xlUp).Row)    Ar = .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)    Br = .Range("E2:E" & .Cells(Rows.Count, 5).End(xlUp).Row)     ReDim Cr(1 To 1000, 1 To 2)     For X = 1 To Rg1.Rows.Count       If Application.CountIf(Rg2, Ar(X, 1)) < 1 Then         K = K + 1         Cr(K, 1) = Ar(X, 1)       End If     Next X     K = 0     For X = 1 To Rg2.Rows.Count       If Application.CountIf(Rg1, Br(X, 1)) = 0 Then         K = K + 1         Cr(K, 2) = Br(X, 1)       End If     Next X     .Cells(2, 8).Resize(1000, 2) = Cr   End With   Set Rg1 = Nothing   Set Rg2 = Nothing End Sub 15.83 KB, 下载次数: 0

 本版积分规则 回帖后跳转到最后一页

GMT+8, 2022-6-30 09:37 , Processed in 0.151262 second(s), 9 queries , Gzip On, Yac On.