根据四位数有无重复数字，进行调整，如何去做啊。

gwjkkkkk

参与一下。。。

yjh_27

1. Function hh(a)
   
2. Dim arr(9)
   
3. For i = 1 To Len(a)
   
4.     n = Mid(a, i, 1)
   
5.     If arr(n) <> "" Then n = (n + 5) Mod 10
   
6.     arr(n) = n
   
7. Next
   
8. hh = Join(arr, "")
   
9. End Function

复制代码

自定义函数

1. 
   

复制代码

醉眼看尘世

1. Sub test()
   
2. Dim Dic As Object, reGxp As Object, tmPstr$, NumStr$
   
3. Dim mRow&, i&, j&, Arr
   
4. Set Dic = CreateObject("scripting.dictionary")
   
5. NumStr = "0123456789"
   
6. Set reGxp = CreateObject("vbScript.regExp")
   
7. reGxp.Global = True
   
8. With Sheet1
   
9.     mRow = .Cells(.Rows.Count, "A").End(3).Row
   
10.     Arr = .[a1].Resize(mRow, 1)
    
11.     With reGxp
    
12.         For i = 2 To UBound(Arr, 1)
    
13.             Dic.RemoveAll
    
14.             For j = 1 To Len(Arr(i, 1))
    
15.                 tmPstr = Mid(Arr(i, 1), j, 1)
    
16.                 If Dic.exists(tmPstr) Then tmPstr = (Val(tmPstr) + 5) Mod 10
    
17.                 Dic(tmPstr) = ""
    
18.             Next j
    
19.             tmPstr = Join(Dic.keys, "")
    
20.             .Pattern = "[^" & tmPstr & "]+"
    
21.             Arr(i, 1) = .Replace(NumStr, "")
    
22.         Next i
    
23.     End With
    
24.     Arr(1, 1) = "结果"
    
25.     .Range("C:C").ClearContents
    
26.     .Range("C:C").NumberFormat = "@"
    
27.     .[c1].Resize(UBound(Arr, 1), 1) = Arr
    
28. End With
    
29. End Sub
    

复制代码

桑榆非晚

谢谢各位大神们，我的花花没有了，还有几位大神没送花花，改日再送啊，谢谢各位，祝各位好人好运好心情！！！

micch

这个逻辑，如果遇到 1166，两个1，需要把其中1个变6，两个6需要把其中一个变1.结果还是1166