请教如何查询并移动数据

3190496160

数据行数问题，代码确实存在一点问题，已经修改了，
至于格式问题，自己在运行代码之前，先设置一下配对成功表的格式即可

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.2.21
   
2.     Dim arr, brr, zrr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("数据组2")
   
7.         r = .Cells(.Rows.Count, "m").End(xlUp).Row
   
8.         arr = .[a1].Resize(r, 13)
   
9.     End With
   
10.     ReDim zrr(1 To UBound(arr), 1 To UBound(arr, 2))
    
11.     For i = 2 To UBound(arr)
    
12.         s = arr(i, 13)
    
13.         If s <> Empty Then
    
14.             If Not d.exists(s) Then d(s) = i
    
15.         End If
    
16.     Next
    
17.     With Sheets("数据组1")
    
18.         r = .Cells(.Rows.Count, "m").End(xlUp).Row
    
19.         brr = .[a1].Resize(r, 13)
    
20.         For i = UBound(brr) To 2 Step -1
    
21.             If brr(i, 13) <> Empty Then
    
22.                 s = brr(i, 13)
    
23.                 If d.exists(s) Then
    
24.                     m = m + 1
    
25.                     For j = 1 To UBound(brr, 2)
    
26.                         zrr(m, j) = arr(d(s), j)
    
27.                     Next
    
28.                     m = m + 1
    
29.                     For j = 1 To UBound(brr, 2)
    
30.                         zrr(m, j) = brr(i, j)
    
31.                     Next
    
32.                     .Rows(i).Delete
    
33.                 End If
    
34.             End If
    
35.         Next
    
36.     End With
    
37.     With Sheets("配对成功")
    
38.         .UsedRange.Offset(1).ClearContents
    
39.         .UsedRange.NumberFormatLocal = "@"
    
40.         .Columns(3).NumberFormatLocal = "0.00"
    
41.         With .[a2].Resize(m, 13)
    
42.             .Value = zrr
    
43.             .Borders.LineStyle = 1
    
44.             .HorizontalAlignment = xlCenter
    
45.             .VerticalAlignment = xlCenter
    
46.             .EntireColumn.AutoFit
    
47.         End With
    
48.     End With
    
49.     Set d = Nothing
    
50.     Application.ScreenUpdating = True
    
51.     MsgBox "OK！"
    
52. End Sub
    

复制代码

yynrzwh

数据配对.rar (217.41 KB, 下载次数: 11)

2024-2-21 10:53 上传

点击文件名下载附件

jsyzlibin

不好意思。可能是我没有表述清楚，我重做了一个简化的附件，“数据组1”中的比对项第一个“条件1 ”到“数据组2”中比对项找到第一个“条件1”如果找到则将这两条数据复制到“配对结果”并删除原表的这行数据，然后再重复上述的动作，附件我把预期的结果行上去了，请参考下。
再次谢谢各位！！！

yynrzwh

试了一下你的新附件，结果并没问题。

cnmlgb9998

1. let
   
2.     源 = Table.NestedJoin(表1, {"比对项"}, 表2, {"比对项"}, "表2", JoinKind.Inner),
   
3.     已添加自定义 = Table.AddColumn(源, "自定义", each Table.FromRecords({Table.First([表2])})),
   
4.     删除的其他列 = Table.SelectColumns(已添加自定义, {"自定义"}),
   
5.     #"展开的“自定义”" = Table.ExpandTableColumn(
   
6.         删除的其他列,
   
7.         "自定义",
   
8.         Cols
   
9.     ),
   
10.     自定义1 = Table.ToRows(#"展开的“自定义”"),
    
11.     自定义2 = 已添加自定义,
    
12.     删除的列 = Table.RemoveColumns(自定义2, {"表2", "自定义"}),
    
13.     自定义3 = Table.ToRows(删除的列),
    
14.     自定义4 = List.Combine(List.Zip({自定义1, 自定义3})),
    
15.     自定义5 = Table.FromRows(自定义4, Cols)
    
16. in
    
17.     自定义5

复制代码

cnmlgb9998

PQ完全可以达到效果。

jsyzlibin

yynrzwh 发表于 2024-2-21 12:02
试了一下你的新附件，结果并没问题。

是的，正确了，刚才没有看清楚，谢谢