如何多表格查找对应内容并复制进总表?

作者：绿色风分类：时间：2022-08-17 浏览：137

楼主
liuguansky

Q:如何可以用代码做到以下功能，根据B列与F列上的数据在另外两个工作表（号码、编码）上，找出对应的数据再把对应的内容复制到总表上。比如B2的CEX11050222在号码表上找出对应的内容（SIMON)填入P列，F2的(VIP111050027)在编码表上找到对应的内容，填入对应的L、M、N、O列上。
A:用如下代码可以实现:

Sub sosogirl()
Dim 号码 As New dictionary, 编码 As New dictionary '申明字典,因前期绑定,需引用VBE工具下,MSCRIPTING.RUNTIME
Dim ar1, ar2, k&, i&, arr, arrresult(), j As Byte '定义变量
With Sheets("号码") '获取号码
k = .Cells(.Rows.Count, 3).End(3).Row - 1
ar1 = .Range("c2").Resize(k, 1).Value
ar2 = .Range("z2").Resize(k, 1).Value
End With
For i = 1 To k
号码(ar1(i, 1)) = ar2(i, 1)
Next i
With Sheets("编码") '获取编码
k = .Cells(.Rows.Count, 3).End(3).Row - 1
ar1 = .Range("c2").Resize(k, 1).Value
ar2 = .Range("ak2").Resize(k, 5).Value
End With
For i = 1 To k
编码(ar1(i, 1)) = i
Next i
With Sheets("总表") '依对应关系处理相应数据
k = .Cells(.Rows.Count, 2).End(3).Row - 1
arr = .Range("b2").Resize(k, 5).Value
ReDim arrresult(1 To k, 1 To 5)
For i = 1 To k
If 号码.exists(arr(i, 1)) Then
arrresult(i, 5) = 号码(arr(i, 1))
End If
If 编码.exists(arr(i, 5)) Then
For j = 1 To 3
arrresult(i, j) = ar2(编码(arr(i, 5)), j)
Next j
arrresult(i, 4) = ar2(编码(arr(i, 5)), 5)
End If
Next i
.Range("l2:p" & Rows.Count).Clear
.Range("l2").Resize(k, 5) = arrresult
End With
End Sub

前期绑定,引用.

2楼
xyf2210

学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表