行列匹配

小电兔

ykcbf1100 发表于 2023-3-22 14:36
附件请参考。。。

大神，我还想请教一下，如果目标表里的字段名与数据源里的顺序并不同，那该如何正确匹配到目标表里呢？在原有的代码该怎么更改呢

ykcbf1100

小电兔 发表于 2023-3-24 10:21
大神，我还想请教一下，如果目标表里的字段名与数据源里的顺序并不同，那该如何正确匹配到目标表里呢？在 ...

发上附件吧。

小电兔

ykcbf1100 发表于 2023-3-24 11:18
发上附件吧。

发上去了，老师。请您看看

ykcbf1100

小电兔 发表于 2023-3-24 11:31
发上去了，老师。请您看看

附件请参考。。。

ykcbf1100

小电兔 发表于 2023-3-24 11:31
发上去了，老师。请您看看

方法应该有不少，这个还可以字典嵌套。

小电兔

ykcbf1100 发表于 2023-3-24 12:28
方法应该有不少，这个还可以字典嵌套。

太感谢了。老师

全党

ykcbf1100 发表于 2023-3-22 14:36
附件请参考。。。

思路没问题，但目标 列和源数据的列顺序不一致，给你改了一下。

1. Sub 字典法复制数据()  '//2023.3.22
   
2.     Dim arr, brr, d, crr
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("数据源").[a1].CurrentRegion
   
5.     crr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheets("数据源").Range("a1:e1")))
   
6.         For i = 2 To UBound(arr)
   
7.             s = arr(i, 1)
   
8.             d(s) = i
   
9.         Next
   
10.     With Sheets("目标表")
    
11.         brr = .[a1].CurrentRegion
    
12.         For i = 2 To UBound(brr)
    
13.             s = brr(i, 1)
    
14.             If d.exists(s) Then
    
15.                 For j = 2 To UBound(brr, 2)
    
16.                   k = WorksheetFunction.Match(brr(1, j), crr, 0)
    
17.                     brr(i, j) = arr(d(s), k)
    
18.                 Next
    
19.             End If
    
20.         Next
    
21.         .[a1].CurrentRegion = brr
    
22.         .[a1].CurrentRegion.Borders.LineStyle = 1
    
23.     End With
    
24. End Sub
    

复制代码

小电兔

ykcbf1100 发表于 2023-3-22 14:36
附件请参考。。。

您好老师，很抱歉这么晚还打扰您，希望您有时间可以看下我发的最新一个问题，也是用您之前提供的字典匹配数据，只是数据变了很多，但不知道为什么无法正确匹配，望您有时间可以帮我看看。因为我觉得您写的代码让我觉得比较直观。自己的积分比较低没法发信息，只能这样联系您。

小电兔

ykcbf1100 发表于 2023-3-22 14:36
附件请参考。。。

老师，您有时间可以帮我看看我最新发的那个帖子吗？也是有关字典的