利用VBA找到满足两个条件的值

cut

大家好，请问如何利用VBA将：
（1）两表当中，同时满足两个条件的，找数值（像VLOOKUP效果）
（2）当表2有不同值，找出补充到表1上？
谢谢~

sunya_0529

WPS里的JSA练习一下——

cut

问题得到解决了，感谢大神

cut

请问一下：如果用VBA的应该改成什么样子啊？

cut

请问改成VBA应该怎样写啊？

jaxxcyh

1. Sub test()
   
2. 
   
3. '-----------------问题1-----------------------
   
4.     Dim arrBaoMing()
   
5.     arrBaoMing = Sheets("报名").Range("A1").CurrentRegion.Value
   
6.     Dim arrXiTong()
   
7.     arrXiTong = Sheets("系统").Range("A1").CurrentRegion.Value
   
8.     Dim arrDiQu()
   
9.     arrDiQu = Sheets("地区").Range("A1").CurrentRegion.Value
   
10.    
    
11.     Dim i%, j%
    
12.     For i = 2 To UBound(arrBaoMing, 1)
    
13.         '获取系统成绩
    
14.         For j = 4 To UBound(arrXiTong, 1)
    
15.             If (arrBaoMing(i, 2) & arrBaoMing(i, 3)) = _
    
16.                 (arrXiTong(j, 3) & arrXiTong(j, 6)) Then
    
17.                arrBaoMing(i, 10) = arrXiTong(j, 13)
    
18.             End If
    
19.         Next
    
20.         
    
21.         '获取地区成绩
    
22.         For j = 2 To UBound(arrDiQu, 1)
    
23.             If (arrBaoMing(i, 2) & arrBaoMing(i, 3)) = _
    
24.                 (arrDiQu(j, 4) & arrDiQu(j, 5)) Then
    
25.                arrBaoMing(i, 11) = arrDiQu(j, 8)
    
26.             End If
    
27.         Next
    
28.     Next
    
29. 
    
30. '-----------------问题2-----------------------
    
31.    
    
32.     '补系统表有名但报名表没名的
    
33.     Dim Exist As Boolean
    
34.     Dim arrTransTmp()
    
35.     For i = 4 To UBound(arrXiTong, 1)
    
36.         If i = 28 Then Stop
    
37.         Exist = False
    
38.         For j = 2 To UBound(arrBaoMing, 1)
    
39.             If arrXiTong(i, 3) & arrXiTong(i, 6) = _
    
40.                 arrBaoMing(j, 2) & arrBaoMing(j, 3) Then
    
41.                 Exist = True
    
42.                 Exit For
    
43.             End If
    
44.         Next
    
45.         
    
46.         If Not Exist Then
    
47.             arrTransTmp = Application.Transpose(arrBaoMing)      '由于二维数组只能给最后维扩容，故进入数组转置
    
48.             ReDim Preserve arrTransTmp(1 To 11, 1 To UBound(arrTransTmp, 2) + 1) '扩充数组
    
49.             arrBaoMing = Application.Transpose(arrTransTmp)      '再转置回来
    
50.             arrBaoMing(UBound(arrBaoMing, 1), 2) = arrXiTong(i, 3)   '补名字
    
51.             arrBaoMing(UBound(arrBaoMing, 1), 3) = arrXiTong(i, 6)   '补身份证
    
52.             arrBaoMing(UBound(arrBaoMing, 1), 10) = arrXiTong(i, 13) '补系统成绩
    
53.             arrBaoMing(UBound(arrBaoMing, 1), 9) = "没有名字"
    
54.         End If
    
55.         
    
56.     Next
    
57.    
    
58.     '补地区表有名但报名表没名的
    
59.     For i = 2 To UBound(arrDiQu, 1)
    
60.         Exist = False
    
61.         For j = 2 To UBound(arrBaoMing, 1)
    
62.             If arrDiQu(i, 4) & arrDiQu(i, 5) = _
    
63.                 arrBaoMing(j, 2) & arrBaoMing(j, 3) Then
    
64.                 Exist = True
    
65.                 Exit For
    
66.             End If
    
67.         Next
    
68.         
    
69.         If Not Exist Then
    
70.             arrTransTmp = Application.Transpose(arrBaoMing)    '由于二维数组只能给最后维扩容，故进入数组转置
    
71.             ReDim Preserve arrTransTmp(1 To 11, 1 To UBound(arrTransTmp, 2) + 1)  '扩充数组
    
72.             arrBaoMing = Application.Transpose(arrTransTmp)    '再转置回来
    
73.             arrBaoMing(UBound(arrBaoMing, 1), 2) = arrDiQu(i, 4)   '补名字
    
74.             arrBaoMing(UBound(arrBaoMing, 1), 3) = arrDiQu(i, 5)   '补身份证
    
75.             arrBaoMing(UBound(arrBaoMing, 1), 10) = arrDiQu(i, 8)  '补地区成绩
    
76.             arrBaoMing(UBound(arrBaoMing, 1), 9) = "没有名字"
    
77.         End If
    
78.     Next
    
79. 
    
80.     '输出新报名表，把[t1]换成[a1]就是放回原位。
    
81.     Sheets("报名").[t1].Resize(UBound(arrBaoMing, 1), 11).Value = arrBaoMing
    
82.    
    
83.     MsgBox "OK"
    
84. 
    
85. End Sub
    

复制代码

一招秒杀

对三个表 分别用 Ctrl+T 设置为表，自动命名为 表1 表2 表3，剩下的用一个简单的 xLookup 函数完美解决，是不是简单到不要不要的，爽到飞起，还写什么晦涩难懂的冗长代码，不需要了。

ykcbf1100

一招秒杀 发表于 2024-8-18 05:48
对三个表 分别用 Ctrl+T 设置为表，自动命名为 表1 表2 表3，剩下的用一个简单的 xLookup 函数完美解决，是 ...

方法简单，但是你没有把新增的补上去，只解决了一部分问题。

cut

谢谢大神们的解答，由于涉及数据过多，考虑公式有点拖慢，故请教大神们，谢谢

一招秒杀

ykcbf1100 发表于 2024-8-18 07:53
方法简单，但是你没有把新增的补上去，只解决了一部分问题。

我只是扫了一眼，没仔细看，没留意到，所有的需求，其实用SQL来解决，1条语句就能全部搞定，哪里需要如此麻烦