如何实现当数据更新原始数据保留时，引用匹配最新数据

Ale黄金

基础数据每个月会更新，需要其中部分商品的当月数据，能不能自动化实现数据的更新引用

ykcbf1100

附件供参考。。。

ykcbf1100

字典。。。。

1. Sub ykcbf()   '//2024.12.19
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     Application.ScreenUpdating = False
   
6.     yf = Month(Date)
   
7.     With Application.FileDialog(msoFileDialogFilePicker)
   
8.         .InitialFileName = ThisWorkbook.Path & ""
   
9.         .Title = "请选择对应Excel文件"
   
10.         .AllowMultiSelect = False
    
11.         .Filters.Clear
    
12.         .Filters.Add "Excel文件", "*.xls*"
    
13.         If .Show Then f = .SelectedItems(1) Else Exit Sub
    
14.     End With
    
15.     Set wb = Workbooks.Open(f, 0)
    
16.     arr = wb.Sheets(1).UsedRange
    
17.     wb.Close 0
    
18.     For j = 3 To UBound(arr, 2)
    
19.         If Val(arr(1, j)) = yf Then jj = j
    
20.     Next
    
21.     For i = 2 To UBound(arr)
    
22.         s = CStr(arr(i, 1))
    
23.         d(s) = arr(i, jj)
    
24.     Next
    
25.     With sh
    
26.         r = .Cells(Rows.Count, 1).End(3).Row
    
27.         For i = 2 To r
    
28.             s = CStr(.Cells(i, 1).Value)
    
29.             If d.exists(s) Then
    
30.                 .Cells(i, 3).Value = d(s)
    
31.             Else
    
32.                 .Cells(i, 3).Value = d(s)
    
33.             End If
    
34.         Next
    
35.     End With
    
36.     Set d = Nothing
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox "OK！"
    
39. End Sub
    

复制代码

Ale黄金

ykcbf1100 发表于 2024-12-19 14:15
附件供参考。。。

感谢 我学习下，貌似新增列进去的话就不行了

ykcbf1100

Ale黄金 发表于 2024-12-19 14:31
感谢 我学习下，貌似新增列进去的话就不行了

你表的结构变了，那代码肯定得改啊。
你以为代码是万能的，代码是根据附件的结构来定制的。

Ale黄金

ok 我再研究下