准备2个表,一个数据表,一个花名册
2个表
基本方法:
开发模式--visual basic--插入--模块
代码如下:
Sub 引用()
Dim i%, r% '定义变量
Dim arr1, arr2 '定义数组
arr1 = Sheets("数据库").[a1].CurrentRegion '表1数据赋值给数组arr1
arr2 = Sheets("花名册").[a1].CurrentRegion '表2数据赋值给数组arr2
r = 1
For r = 1 To UBound(arr2) '可以看成表2的行数
For i = 1 To UBound(arr1) '可以看成表1的行数
If arr2(r, 1) = arr1(i, 1) Then '可以看成如果表1和表2各自的第1列数据有一样的
arr2(r, 2) = arr1(i, 2) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 3) = arr1(i, 4) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 4) = arr1(i, 3) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 5) = arr1(i, 5) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 6) = arr1(i, 6) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 7) = arr1(i, 7) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 8) = arr1(i, 8) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 9) = arr1(i, 9) '那么把表1对应的第2列数据赋值给表2的第2列数据
arr2(r, 10) = arr1(i, 10) '那么把表1对应的第2列数据赋值给表2的第2列数据
Exit For '结束循环遍历
End If
Next
Next
Sheets("花名册").[a1].Resize(UBound(arr2), 2) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 4) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 3) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 5) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 6) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 7) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 8) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 9) = arr2 '把更新后的数组arr2复制到表2
Sheets("花名册").[a1].Resize(UBound(arr2), 10) = arr2 '把更新后的数组arr2复制到表2
End Sub
注意里面列的关系,不要弄混,就可以了
保存后,退出
开发模式---插入--图标--右击--指定红---引用--确定