统计符合规定条件的2列数据相等或不相等的个数（不包括重复数）

dy591025 · 发表于 2022-10-10 14:41

尊敬的各位老师，您好
由于规则2-3的限制，我在网上未能搜寻到适用的相关设置方案，故恳请大咖们给予帮助1

规则1：
1、统计A列为空，且B列不等于D列数值的个数（不包括重复数）
2、B列和D列数值个数不同，排列不是按行一一对应
3、B列和D列数值可以分列在同一个文件2个工作表或不同文件
规则2：统计A列为空，且B列等于D列数值的个数（不包括重复数）

统计符合规定条件的2列数据相等或不相等的个数（不包括重复数）.rar (6.6 KB, 下载次数: 11)

yunraner · 发表于 2022-10-10 15:26

数据损坏了。

大猫不吃鱼 · 发表于 2022-10-11 22:39

规则1和规则2，不是一样的？

大猫不吃鱼 · 发表于 2022-10-11 22:40

没看懂题目

劲钟华 · 发表于 2022-10-12 17:20

Sub CheckTwoClnData()
Dim d As Object
Dim i As Long, n1 As Long, n2 As Long, n3 As Long, m As Long
Dim strTemp As String
Dim arr1 As Variant, arr2 As Variant, brr As Variant, kr As Variant
Dim rng1 As Range, rng2 As Range, rng As Range
Set d = CreateObject("scripting.dictionary")
On Error Resume Next
Set rng1 = Application.InputBox("请选择需要核对差异的第一列数据", Type:=8)
'用户选取第一列数据（用A表示）
If rng1.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub
If rng1.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub
Set rng1 = Intersect(rng1.Parent.UsedRange, rng1)
'防止用户选取整列造成运算量虚大效率低下
If Not rng1 Is Nothing Then arr1 = rng1.Value
'将第一列数据装入arr1
Set rng2 = Application.InputBox("请选择需要核对差异的第二列数据", Type:=8)
'用户选取第二列数据（用B表示）
If rng2.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub
If rng2.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub
Set rng2 = Intersect(rng2.Parent.UsedRange, rng2)
If Not rng2 Is Nothing Then arr2 = rng2.Value
For i = 2 To UBound(arr1) '扣除标题行
If Len(arr1(i, 1)) Then
d("'" & arr1(i, 1)) = "不存在"
'将数据统一强制转换为字符串格式
'数据装入字典，先统一设置item为不存在
End If
Next
If UBound(arr1) > UBound(arr2) Then
'计算两列最大行数
m = UBound(arr1)
Else
m = UBound(arr2)
End If
ReDim brr(0 To m, 1 To 3)
'结果数组
'第一列放AB均存在的数据
'第二列放A有B没有的数据
'第三列放A没有B有的数据
For i = 2 To UBound(arr2)
If Len(arr2(i, 1)) Then
strTemp = "'" & arr2(i, 1)
If d.exists(strTemp) Then '如果A也有
n1 = n1 + 1
brr(n1, 1) = strTemp
d(strTemp) = "存在" '将AB均有的数据item修改为存在
Else '如果A没有
n3 = n3 + 1
brr(n3, 3) = strTemp
End If
End If
Next
kr = d.keys
For i = 0 To UBound(kr)
If d(kr(i)) = "不存在" Then '如果A有B没有
n2 = n2 + 1
brr(n2, 2) = kr(i)
End If
Next
Err.Clear
Set rng = Application.InputBox("请选择放置查询结果的单元格，例如C1", Type:=8)
rng.Parent.Select
rng.Select
If Err.Number = 0 Then
brr(0, 1) = "两列均存在的数据有" & n1 & "条"
brr(0, 2) = "A有B没有的数据有" & n2 & "条" 'A列独有的数据
brr(0, 3) = "A没有B有的数据有" & n3 & "条" 'B列独有的数据
With rng(1).Resize(UBound(brr) + 1, 3)
.ClearContents '打扫房间
.NumberFormatLocal = "@" '设置文本格式，防止文本数值变形
.Value = brr
End With
MsgBox "核对完成。" & vbLf & brr(0, 1) & vbLf & brr(0, 2) & vbLf & brr(0, 3)
End If
Set d = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
Erase arr1: Erase arr2: Erase brr
End Sub

复制代码

这是我收藏的网搜的代码，应该部分符合你的要求。结果出来，两列都有的，删除一下重复项就行了。

dy591025 · 发表于 2022-10-12 17:41

规则1，是统计B列数值不等于D列数值的个数，其中重复的统计为1，如：B列的234567899和456789999，D列中没有（即不等于）），其中234567899存在重复，只统计为1，故统计为2

规则2，是统计B列数值等于D列数值的个数，其中重复的统计为1，如：B列的209364045、123456789和345678999，与D列中数值相同（即等于），其中209364045存在重复，只统计为1，故统计为3，恳请各位老师给与帮助，为谢！

统计符合规定条件的2列数据相等或不相等的个数（不包括重复数）.rar (7.68 KB, 下载次数: 1)

dy591025 · 发表于 2022-10-13 09:19

劲钟华发表于 2022-10-12 17:20
这是我收藏的网搜的代码，应该部分符合你的要求。结果出来，两列都有的，删除一下重复项就行了。

谢谢
2列数据在不同的工作表中，宏代码如何设置？

dy591025 · 发表于 2022-10-13 10:48

在网上搜寻的数组公式：COUNT(MATCH(B:B,D:D,0))
可以统计B列等于D列数值的个数为4，如何去掉209364045重复的个数，如何设置A列为空的条件；同理，如何设置统计B列不等于D列数值的个数（去掉234567899重复个数）

劲钟华 · 发表于 2022-10-13 11:09

本帖最后由劲钟华于 2022-10-13 12:43 编辑

dy591025 发表于 2022-10-13 09:19
谢谢
2列数据在不同的工作表中，宏代码如何设置？

同一个工作簿中两个表也适用，选择第二列的时候，点开另一个工作表再选择列就可以了。代码默认一行标题。

		自动登录	找回密码
密码			免费注册

[求助] 统计符合规定条件的2列数据相等或不相等的个数（不包括重复数）