请教如何查询并移动数据

jsyzlibin · 发表于 2024-2-21 08:58

请教各位大神：附件中文档共有三张表：“数据组1”、“数据组2”、“配对成功”，在“数据组1”表中“比对项”栏内容逐个到“数据组2”表中查询，会查询到多条记录，只选第一条记录移动到“配对成功”表中，同时将“数据表1”中的该条记录也移动到“配对成功”表中。如果查询不到，在“数据组1”中选择下一个比对项，全部配对完成后，“配对成功”表中数据是一一对应的。

yynrzwh · 发表于 2024-2-21 09:21

移动，就是原表数据要删除？
或是复制？

jsyzlibin · 发表于 2024-2-21 09:22

yynrzwh 发表于 2024-2-21 09:21
移动，就是原表数据要删除？
或是复制？

原表数据删除

ykcbf1100 · 发表于 2024-2-21 09:51

根据哪项去比对呢？不会是整行比对吧。

先观望一下。。。

3190496160 · 发表于 2024-2-21 09:51

Sub 比对()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim arr()
Dim rn1 As Range, rn2 As Range
With Sheets("数据组1")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 2 Then MsgBox "数据组1为空！": End
ar = .Range("a1:m" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 13) <> "" Then
      d(ar(i, 13)) = i
End If
Next i
With Sheets("数据组2")
rs = .Cells(Rows.Count, 1).End(xlUp).Row
If rs < 2 Then MsgBox "数据组2为空！": End
br = .Range("a1:m" & rs)
End With
ReDim arr(1 To UBound(ar) + UBound(br), 1 To UBound(ar, 2))
For i = 2 To UBound(br)
If br(i, 13) <> "" Then
      xh = d(br(i, 13))
      If xh <> "" Then
         n = n + 2
         For j = 1 To 13
            arr(n - 1, j) = ar(xh, j)
            arr(n, j) = br(i, j)
         Next j
         If rn1 Is Nothing Then
            Set rn1 = Sheets("数据组1").Rows(xh)
         Else
            Set rn1 = Union(rn1, Sheets("数据组1").Rows(xh))
         End If
         If rn2 Is Nothing Then
            Set rn2 = Sheets("数据组2").Rows(i)
         Else
            Set rn2 = Union(rn2, Sheets("数据组2").Rows(i))
         End If
      End If
End If
Next i
If n = "" Then MsgBox "没有匹配到数据！": End
With Sheets("配对成功")
.[a1].CurrentRegion.Offset(1) = Empty
.[a2].Resize(n, UBound(arr, 2)) = arr
End With
rn1.Delete
rn2.Delete
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-2-21 09:52

数据配对.rar (201.3 KB, 下载次数: 6)

jsyzlibin · 发表于 2024-2-21 09:53

ykcbf1100 发表于 2024-2-21 09:51
根据哪项去比对呢？不会是整行比对吧。

先观望一下。。。

根据“比对项”列的内容逐个比对

jsyzlibin · 发表于 2024-2-21 10:07

3190496160 发表于 2024-2-21 09:52

先谢谢你，运行结果有点问题，我原表“数据组1”有245行数据，“数据表2”有2328行数据，配对之后三张表的总数据应该是2573行，附件中的运行结果是3129行，还有一个问题，配对成功的数据没有沿用原格式

洋务德雷 · 发表于 2024-2-21 10:30

看了一下，你的数据组1中的有245条记录，比对项有38个重复项。这个重复项是不是需要删除。删除以后是207个比对项。按照你得要求数据组2只有一条记录提取出来。那么在配对成功表中，查出的记录不应该超过207条。数据组1和数据组2得总和2573条记录。如果要加上配对成功表中的记录，三张表总记录条不超过2780条。

3190496160 · 发表于 2024-2-21 10:31

数据配对.rar (201.29 KB, 下载次数: 13)

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