ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð±Ð3¦ì¼Æ±Æ¦C²Õ¦X

¦^´_ 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
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

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

00¿ù.png (87.6 KB)

00¿ù.png

TOP

¦^´_ 11# ML089

TOP

¦^´_ 13# eric7765

023 ¨ä¹ê¬O 23·|¦³¿ù»~
­n¿é¤J '023
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 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
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD