请老师用公式或VBA,每行数字之和等于其中一个数，就依次向下排列，谢谢！

cartel

请老师用公式或VBA,每行数字之和等于其中一个数，就依次向下排列，谢谢！.zip (17.61 KB, 下载次数: 9)

2024-6-5 13:22 上传

点击文件名下载附件

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.5
   
2.     r = Cells(Rows.Count, "Y").End(3).Row
   
3.     b = Split([x2].Value, ",")
   
4.     [AC:AD] = ""
   
5.     For i = 1 To r
   
6.         st = Split(Cells(i, "y"), ",")
   
7.         Sum = 0
   
8.         For x = 0 To UBound(st)
   
9.             Sum = Sum + Val(st(x))
   
10.         Next
    
11.         For y = 0 To UBound(b)
    
12.             If Val(b(y)) = Sum Then
    
13.                 m = m + 1
    
14.                 Cells(m, "AC") = Cells(i, "y")
    
15.                 Cells(m, "AD") = Sum
    
16.             End If
    
17.         Next
    
18.     Next
    
19.     MsgBox "OK！"
    
20. End Sub
    

复制代码

LIUZHU

参与下，效果展示

LIUZHU

JSA代码，供参考

1. function test(){
   
2.         let res=[];
   
3.         Range("y1:y11").Value2.forEach(function([x]){
   
4.                 let sum=x.split(",").reduce((a,b)=>a+Number(b),0) + "";
   
5.                 return this.includes(sum)?res.push([x,sum]):null, res;
   
6.         },Range("x2").Value2.split(","));
   
7.         Range("ad1").Resize(res.length,res[0].length).Value2=res;
   
8. }

复制代码

LIUZHU

附件，楼主的WPS正好可以测试

grf1973

用wps测试。。

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, cr, i&, j&, r&, n&, strTxt$
   
    ar = Range("Y1", Cells(Rows.Count, "Y").End(xlUp)).Value
    ReDim br(1 To UBound(ar), 1)
   
    strTxt = "," & [X2].Value & ","
    For i = 1 To UBound(ar)
        n = 0
        cr = Split(ar(i, 1), ",")
        For j = 0 To UBound(cr)
            n = n + cr(j)
        Next j
        If InStr(strTxt, "," & n & ",") Then
             r = r + 1
             br(r, 0) = ar(i, 1)
             br(r, 1) = n
        End If
    Next i
   
    [AC1].Resize(r, 2) = br
    Beep
End Sub

gwjkkkkk

参与一下。。。