ML089

¦^´_ 10# eric7765

¸Õ¸Õ¬Ý¬Ý¡A¥Ñ000~999

Sub ±Æ¦C3()
    Range("D2:E999").ClearContents
    j = 1
    For i = 2 To [a65536].End(xlUp).Row
        If Cells(i, "C").Value = "P" Then
            'For Each k In Array(123, 132, 213, 231, 312, 321)
            For k = 1000 To 1999
                    a = Cells(i, "A")
                    xA = 7 ^ Mid(a, 1, 1) + 7 ^ Mid(a, 2, 1) + 7 ^ Mid(a, 3, 1)
                    xK = 7 ^ Mid(k, 2, 1) + 7 ^ Mid(k, 3, 1) + 7 ^ Mid(k, 4, 1)
                    If xA = xK Then
                        j = j + 1
                        Cells(j, "D") = Mid(k, 2, 3)
                        Cells(j, "E") = Cells(i, "B")
                    End If
            Next k
        Else
            j = j + 1
            Cells(j, "D") = Cells(i, "A")
            Cells(j, "E") = Cells(i, "B")
        End If
    Next i
End Sub

eric7765

¦^´_ 11# ML089
m¤j ­è­è´ú¸Õªºµ²ªG ¥u­n¶}ÀY¬O0 ex:001 023 013 ´N·|¥X²{®æ¦¡¤£²Å

¤U¸ü (87.6 KB)

2019-3-4 18:06

eric7765

¦^´_ 11# ML089

¤U¸ü (63.12 KB)

2019-3-4 18:16

ML089

¦^´_ 13# eric7765

023 ¨ä¹ê¬O 23·|¦³¿ù»~
­n¿é¤J '023

stillfish00

¦^´_ 7# eric7765
CÄ椤 ¦pªG¦³¥ô·N¦r¦A¶i¦æ±Æ¦C

1. Sub Solution()
   
2.     Range(Cells(2, "D"), Cells(Rows.Count, "E")).ClearContents  ' Clear result
   
3.     If Cells(Rows.Count, "A").End(xlUp).Row < 2 Then Exit Sub   ' Exit if no input
   
4.     Dim text As String, id, r
   
5.     r = 1
   
6.     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
   
7.         text = Cells(i, "A").text
   
8.         id = Cells(i, "B").Value
   
9.         If Len(text) > 0 Then
   
10.             If Len(Cells(i, "C").text) > 0 Then
    
11.                 For Each s In GetAllPermutation(text)
    
12.                     r = r + 1
    
13.                     Cells(r, "D").Value = s
    
14.                     Cells(r, "E").Value = id
    
15.                 Next
    
16.             Else
    
17.                     r = r + 1
    
18.                     Cells(r, "D").Value = text
    
19.                     Cells(r, "E").Value = id
    
20.             End If
    
21.         End If
    
22.     Next
    
23. End Sub
    
24. Function GetAllPermutation(ansi_str As String)
    
25.     Dim ans: Set ans = CreateObject("scripting.dictionary")
    
26.     Dim ch, new_ans
    
27.     ans("") = 0
    
28.     For i = 1 To Len(ansi_str)
    
29.         ch = Mid(ansi_str, i, 1)
    
30.         Set new_ans = CreateObject("scripting.dictionary")
    
31.         For Each s In ans.keys()
    
32.             For j = 0 To Len(s)
    
33.                 new_ans(Left(s, j) & ch & Mid(s, j + 1)) = 0
    
34.             Next
    
35.         Next
    
36.         Set ans = new_ans
    
37.     Next
    
38.     GetAllPermutation = ans.keys()
    
39. End Function

½Æ»s¥N½X