请教老师，用VBA找出相对应数的和值，并显示在其它列，谢谢！

limonet

试试函数，函数也是excel的精华

=HSTACK(TOCOL(MAP(O1:O9,LAMBDA(x,IF(ISNUMBER(MATCH(SUM(--TEXTSPLIT(x,,",")),--TEXTSPLIT($J$2,,","),)),x,#N/A))),3),TOCOL(MAP(O1:O9,LAMBDA(x,IF(ISNUMBER(MATCH(SUM(--TEXTSPLIT(x,,",")),--TEXTSPLIT($J$2,,","),)),SUM(--TEXTSPLIT(x,,",")),#N/A))),3))

micch

不考虑其他特殊情况

1. Sub Test()
   
2.     hestr = "," & Range("J2").Value & ","
   
3.     Set Rng = Cells(1, "O")
   
4.     Do While Len(Rng.Value) > 0
   
5.         he = Application.Evaluate(Replace(Rng.Value, ",", "+"))
   
6.         If InStr(hestr, "," & he & ",") > 0 Then
   
7.             r = r + 1
   
8.             Cells(r, "P").Value = Rng.Value
   
9.             Cells(r, "R").Value = he
   
10.         End If
    
11.         Set Rng = Rng.Offset(1)
    
12.     Loop
    
13. End Sub
    

复制代码

陈永生

已经测试可以实现你的目的

1. 
   
2. Function total(ParamArray num())
   
3.     Dim j
   
4.     For Each ar In num
   
5.        For Each a In ar
   
6.         j = j + Int(a)
   
7.        Next
   
8.     Next
   
9.     total = j
   
10. End Function
    
11. 
    
12. 
    
13. Sub test()
    
14.     '将j2单元格写入数组
    
15.     Dim arr_a
    
16.     arr_a = Split(Range("j2"), ",")
    
17.    
    
18.     '将o列数据循环处理
    
19.     Dim i As Long, arr_b, x, y, w
    
20.     For i = 1 To Cells(Rows.Count, 15).End(xlUp).Row
    
21.         arr_b = Split(Cells(i, 15), ",")
    
22.         x = total(arr_b) 'o列单元格数据求和
    
23.         For y = 0 To UBound(arr_a)
    
24.             If x = Int(arr_a(y)) Then
    
25.                 w = w + 1
    
26.                 Cells(w, "p") = Cells(i, "o")
    
27.                 Cells(w, "r") = arr_a(y)
    
28.             End If
    
29.         Next y
    
30.     Next i
    
31. End Sub

复制代码

陈永生

测试了下 可以实现你的要求

perfect131

这题 根本用不到字典

perfect131

1. Sub kong()
   
2.     arr = [o1:o9]
   
3.     a = "," & [j2] & ","
   
4.     ReDim ar(1 To UBound(Split(a, ",")) - 1, 1 To 3)
   
5.     For i = 1 To UBound(arr)
   
6.         If Len(arr(i, 1)) Then
   
7.             aa = Evaluate(Replace(arr(i, 1), ",", "+"))
   
8.             If Len(a) = 0 Then Exit For
   
9.             If InStr(1, a, "," & aa & ",") Then
   
10.                 j = j + 1
    
11.                 ar(j, 1) = arr(i, 1)
    
12.                 ar(j, 3) = aa
    
13.                 Replace a, "," & aa & ",", ""
    
14.             End If
    
15.         End If
    
16.     Next
    
17.     [p1].Resize(j, 3) = ar
    
18. End Sub

复制代码