按单元格相加排序

ba3259878266

duquancai 发表于 2018-9-1 21:40
再挤牙膏 就没有意思了！！！请测试如下代码！

谢谢 你的复杂 看不懂 不需要 我要2楼的

duquancai

ba3259878266 发表于 2018-9-1 21:47
谢谢 你的复杂 看不懂 不需要 我要2楼的

要完全满足你的需求，要拆分f1的数字，要循环判断提取，要排序，要去重复。。。。。他写出来的代码未必就比我的简单。

ba3259878266

duquancai 发表于 2018-9-1 22:47
要完全满足你的需求，要拆分f1的数字，要循环判断提取，要排序，要去重复。。。。。他写出来的代码未必 ...

谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

ba3259878266

duquancai 发表于 2018-9-1 20:25

谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

ba3259878266

duquancai 发表于 2018-9-1 22:47
要完全满足你的需求，要拆分f1的数字，要循环判断提取，要排序，要去重复。。。。。他写出来的代码未必 ...

谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

ba3259878266

duquancai 发表于 2018-9-1 22:47
要完全满足你的需求，要拆分f1的数字，要循环判断提取，要排序，要去重复。。。。。他写出来的代码未必 ...

谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

ba3259878266

duquancai 发表于 2018-9-1 22:47
要完全满足你的需求，要拆分f1的数字，要循环判断提取，要排序，要去重复。。。。。他写出来的代码未必 ...

谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

Kaohsing

1. Sub js()
   
2.     Dim js As Object, ar
   
3.     ar = Range("h1:h" & Cells(Rows.Count, 8).End(3).Row)
   
4.     Dim js As Object
   
5.     Set js = CreateObject("MSScriptControl.ScriptControl"):    js.Language = "JavaScript"
   
6.     js.AddCode "function aa(a){return new VBArray(a).toArray().sort(function(x,y){return x-y});}"
   
7.     js.AddObject "g", js.CodeObject.aa(ar):    js.AddCode "k='" & [j1].Text & "'"
   
8.     js.AddCode "var js=0;var su='';for(i=0;i<g.length;i++){if(g[i]){var z=g[i].split('');var s=Number(z[1]) +Number(z[2]);if( s>9){s=s-10;};if (k.indexOf(String(s))>=0){js++;su+=g[i]+',';}  }};"
   
9.     If js.eval("js") > 0 Then [k1].Resize(js.eval("js"), 1) = Application.Transpose(Split(js.eval("su"), ","))
   
10.    
    
11. End Sub

复制代码

Kaohsing

ba3259878266 发表于 2018-9-2 00:34
谢谢你的热心帮忙  请问 数字6538  比如是ABCD  你写的是 BC相加 如果改为 AD相加 怎样修改？

1. Sub js()
   
2.     Dim js As Object, ar, t1, t2
   
3.     ar = Range("h1:h" & Cells(Rows.Count, 8).End(3).Row)
   
4.     indexs = Space(8) & "假设数据格式ABCD,默认BC组合【2】"
   
5.     indexs = indexs & vbCrLf & "1....获取AD组合"
   
6.     indexs = indexs & vbCrLf & "2....获取BC组合"
   
7.     s = InputBox(indexs, "    获取组合方式", 2)
   
8.     If s = "" Then End
   
9.     If s = 1 Then
   
10.         t1 = 0: t2 = 3
    
11.     Else
    
12.         t1 = 1: t2 = 2
    
13.     End If
    
14.     Set js = CreateObject("MSScriptControl.ScriptControl"):    js.Language = "JavaScript"
    
15.     js.AddCode "function aa(a){return new VBArray(a).toArray().sort(function(x,y){return x-y});}"
    
16.     js.AddObject "g", js.CodeObject.aa(ar):    js.AddCode "k='" & [j1].Text & "'"
    
17.     js.AddCode "var js=0;var su='';for(i=0;i<g.length;i++){if(g[i]){var z=g[i].split('');var s=Number(z[" & t1 & "]) +Number(z[" & t2 & "]);if( s>9){s=s-10;};if (k.indexOf(String(s))>=0){js++;su+=g[i]+',';}  }};"
    
18.     If js.eval("js") > 0 Then [k1].Resize(js.eval("js"), 1) = Application.Transpose(Split(js.eval("su"), ","))
    
19.    
    
20. End Sub

复制代码

ba3259878266

Kaohsing 发表于 2018-9-2 17:12

谢谢你 师傅 很好用