[已解决]关于比对数据

fanzhongren123

表1和表2的某一列数据进行一一比对，比对成功后，将表2的 另一列 填到 表1 的另一列。。

最佳答案

月排行榜 / 总排行榜

chart888

2017-6-28 13:53

1. Private Sub CommandButton1_Click()
   
2. Dim Arr, Brr
   
3. Dim i, j
   
4. Application.ScreenUpdating = False
   
5. Set d = CreateObject("scripting.dictionary")
   
6. Arr = Worksheets("总表").[A1].CurrentRegion
   
7. For i = 2 To UBound(Arr)
   
8.     d(Arr(i, 1)) = Arr(i, 2)
   
9. Next
   
10. With Worksheets("明细表")
    
11.     r = .Cells(Rows.Count, 1).End(3).Row
    
12.     Brr = Worksheets("明细表").Range("A2:B" & r)
    
13.     For j = 1 To UBound(Brr)
    
14.         If d.exists(Brr(j, 1)) Then
    
15.             Brr(j, 2) = d(Brr(j, 1))
    
16.         End If
    
17.     Next
    
18.     .Range("A2:B" & r).ClearContents
    
19.     .Range("A2:B" & r) = Brr
    
20. End With
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

跳转到最佳答案楼层

fanzhongren123

唉。。

chart888

不是一对一的 怎么进行匹配?

大灰狼1976

B2单元格输入公式，下拉
=VLOOKUP(A2,总表!$A$1:$B$5,2,FALSE)
当然如果必须要用VBA的话也是可以的。

fanzhongren123

chart888 发表于 2017-6-28 13:01
不是一对一的 怎么进行匹配?

1对1，1对多都有可能出现。。  如果符合，1对1或1对多 后面的那列 就填 1 后面的那列。

chart888

fanzhongren123 发表于 2017-6-28 13:08
1对1，1对多都有可能出现。。  如果符合，1对1或1对多 后面的那列 就填 1 后面的那列。

你能举个例子吗

fanzhongren123

两张表。 总表和明细表，共同点是 都有单号。只是明细表的同一个单号会出2次或更多次。 如果明细表的单号和总表的单号对上了，那么就把明细表的单号后面一列填入 总表单号的后面一列。

fanzhongren123

大灰狼1976 发表于 2017-6-28 13:03
B2单元格输入公式，下拉
=VLOOKUP(A2,总表!$A$1:$B$5,2,FALSE)
当然如果必须要用VBA的话也是可以的。

公式不行哦。。几千行数据，只有前四行可以查找出。后面的都出现了错误

chart888

1. Private Sub CommandButton1_Click()
   
2. Dim Arr, Brr
   
3. Dim i, j
   
4. Application.ScreenUpdating = False
   
5. Set d = CreateObject("scripting.dictionary")
   
6. Arr = Worksheets("总表").[A1].CurrentRegion
   
7. For i = 2 To UBound(Arr)
   
8.     d(Arr(i, 1)) = Arr(i, 2)
   
9. Next
   
10. With Worksheets("明细表")
    
11.     r = .Cells(Rows.Count, 1).End(3).Row
    
12.     Brr = Worksheets("明细表").Range("A2:B" & r)
    
13.     For j = 1 To UBound(Brr)
    
14.         If d.exists(Brr(j, 1)) Then
    
15.             Brr(j, 2) = d(Brr(j, 1))
    
16.         End If
    
17.     Next
    
18.     .Range("A2:B" & r).ClearContents
    
19.     .Range("A2:B" & r) = Brr
    
20. End With
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

grf1973

请看附件。。。。。。。。。。