Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 110|回复: 3

提取差异数

[复制链接]
发表于 2022-6-20 17:10 | 显示全部楼层 |阅读模式
提取差异数,请用VBA

找出不出的值.rar

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

1.JPG
回复

使用道具 举报

 楼主| 发表于 2022-6-20 18:33 | 显示全部楼层
回复

使用道具 举报

发表于 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

找出不出的值.rar

15.83 KB, 下载次数: 0

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

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

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表