按单元格相加排序

ba3259878266

719404338 发表于 2018-9-1 19:20
已修改，你看一下，还是在2楼。

师傅 谢谢 太好了

ba3259878266

719404338 发表于 2018-9-1 19:20
已修改，你看一下，还是在2楼。

师傅 麻烦你 还有一个问题  如果J1里有3456 怎样把 3的 4的 5的 6的 多个都选出来呢 谢谢

duquancai

ba3259878266 发表于 2018-9-1 18:42
师傅 麻烦你修改一下 J1有可能是 0---9  十位 百位大于10的 取最后一位 如 8+9=17  取 7  谢谢

1. Sub main()
   
2.     '答案再后面！
   
3. End Sub

复制代码

duquancai

完全是挤牙膏似的提问。最烦这种。

ba3259878266

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

师傅 有出错 你看看

ba3259878266

ba3259878266 发表于 2018-9-1 19:37
师傅 麻烦你 还有一个问题  如果J1里有3456 怎样把 3的 4的 5的 6的 多个都选出来呢 谢谢

师傅 有空修改一下吗

ba3259878266

719404338 发表于 2018-9-1 19:20
已修改，你看一下，还是在2楼。

师傅 能写一下吗  J1有多个数字  符合条件的都选出来  如果J1里有3456..... 把 3的 4的 5的 6的.... 多个都选出来  谢谢

719404338

ba3259878266 发表于 2018-9-1 21:02
师傅 能写一下吗  J1有多个数字  符合条件的都选出来  如果J1里有3456..... 把 3的 4的 5的 6的.... 多个 ...

把0-9写在J1--J10,找出来后放在K-T列

Sub t()
   Dim i%, j%, k%, m%
   m = 11   
   For k = 1 To 10
   j = 1
  For i = 1 To [h65536].End(3).Row
    If (Val(Mid(Range("h" & i), 2, 1)) + Val(Mid(Range("h" & i), 3, 1))) Mod 10 = Range("j" & k) Then
    Cells(j, m) = Range("h" & i)   
   j = j + 1
   End If
    Next i
    m = m + 1
    Next k
End Sub

duquancai

ba3259878266 发表于 2018-9-1 21:02
师傅 能写一下吗  J1有多个数字  符合条件的都选出来  如果J1里有3456..... 把 3的 4的 5的 6的.... 多个 ...

再挤牙膏 就没有意思了！！！请测试如下代码！

1. Sub main()
   
2.     Dim arr, k$, s$, j$, brr(), l&, d As Object, js As Object
   
3.     arr = Range("h1:h" & Cells(Rows.Count, "h").End(3).Row)
   
4.     k = [j1]: Range("k:k").Clear: Range("k:k").NumberFormat = "@"
   
5.     For i = 1 To UBound(arr)
   
6.         If Len(arr(i, 1)) Then s = s & "," & "'" & arr(i, 1) & "'"
   
7.     Next
   
8.     s = "[" & Mid(s, 2) & "]"
   
9.     Set d = CreateObject("htmlfile"): Set js = d.parentWindow
   
10.     js.execScript "k='" & k & "'.split(''),b=[],a=" & s & ",o={};"
    
11.     j = "for(j=0;j<k.length;j++){for(i=0;i<a.length;i++){s=''+(a[i].slice(-2,-1)*1+a[i].slice(-3,-2)*1);"
    
12.     j = j & "if(s.charAt(s.length-1)===k[j])o[a[i]]=0;};};for(k in o)b.push(k);b.sort(function(x,y){return x*1-y*1});"
    
13.     l = js.eval(j & "b.length"): ReDim brr(1 To l, 1 To 1)
    
14.     For i = 0 To l - 1
    
15.         brr(i + 1, 1) = js.eval("b[" & i & "];")
    
16.     Next
    
17.     Range("k1").Resize(l, 1) = brr
    
18. End Sub

复制代码

ba3259878266

719404338 发表于 2018-9-1 21:24
把0-9写在J1--J10,找出来后放在K-T列

Sub t()

谢谢师傅 这样不好集中管理  数据多 能集中到K列吗 去除重复 升序排列 另一个 J列空白单元格不算是相加等于0