[已解决]大侠们帮个忙，看这代码如何写

坏也是一种态度

附件中有两个表一个是原始表，一个是需要填充的表 两表中K列为编码，需要把根据编码把原始表中M、N列数据提取填充到需要填充的表的M、N列 哪位大侠帮忙下忙看代码如何写，具体的详见附件 十分感谢 在线等，很急

最佳答案

月排行榜 / 总排行榜

七彩屋

2015-8-30 18:39

1. Sub qcw()
   
2. Application.ScreenUpdating = False
   
3. Dim wb As Workbook, arr, brr
   
4.     Set wb = Workbooks.Open(ThisWorkbook.Path & "" & "原始表.xlsx")  '读入
   
5.     lr = wb.Worksheets(1).Range("k65536").End(xlUp).Row
   
6.     arr = wb.Worksheets(1).Range("k1:n" & lr)
   
7.     wb.Close False
   
8.     brr = Range("k1:n" & Range("k65536").End(xlUp).Row)
   
9. For i = 2 To UBound(brr)
   
10.   For j = 2 To UBound(arr)
    
11.     If brr(i, 1) = arr(j, 1) Then
    
12.       brr(i, 3) = arr(j, 3)
    
13.       brr(i, 4) = arr(j, 4)
    
14.     End If
    
15.   Next j
    
16. Next i
    
17. Range("k1").Resize(UBound(brr), 4) = brr
    
18. Application.ScreenUpdating = True
    
19. End Sub
    

复制代码

求助需求0830.rar (19.9 KB, 下载次数: 6)

2015-8-30 19:34 上传

点击文件名下载附件

跳转到最佳答案楼层

七彩屋

1. Sub qcw()
   
2. Application.ScreenUpdating = False
   
3. Dim wb As Workbook, arr, brr
   
4.     Set wb = Workbooks.Open(ThisWorkbook.Path & "" & "原始表.xlsx")  '读入
   
5.     lr = wb.Worksheets(1).Range("k65536").End(xlUp).Row
   
6.     arr = wb.Worksheets(1).Range("k1:n" & lr)
   
7.     wb.Close False
   
8.     brr = Range("k1:n" & Range("k65536").End(xlUp).Row)
   
9. For i = 2 To UBound(brr)
   
10.   For j = 2 To UBound(arr)
    
11.     If brr(i, 1) = arr(j, 1) Then
    
12.       brr(i, 3) = arr(j, 3)
    
13.       brr(i, 4) = arr(j, 4)
    
14.     End If
    
15.   Next j
    
16. Next i
    
17. Range("k1").Resize(UBound(brr), 4) = brr
    
18. Application.ScreenUpdating = True
    
19. End Sub
    

复制代码

求助需求0830.rar (19.9 KB, 下载次数: 6)

2015-8-30 19:34 上传

点击文件名下载附件

坏也是一种态度

七彩屋 发表于 2015-8-30 18:39

十分感谢大侠帮助，但大侠，我每个工作薄里面都有许多表的，这需要选择呀
这代码应该如何修改下才行