Warum ersetzt der Code Trennzeichen?

2

Ich bin neu in Excel VBA und lerne, indem ich vorhandenen Code ändere / ändere. Ich habe einen Code ausprobiert, der eine Zeichenfolge akzeptiert und mir die nächste Permutation gibt. Meine Daten befinden sich in Zelle A1 und bestehen aus durch Kommas getrennten Zahlen. Die Begrenzer werden als Teil der Daten behandelt. Wenn ich versuche, zweistellige Zahlen (10 usw.) zu permutieren, werden diese als 1 und 0 behandelt.

Function nextPerm(s As String)
' inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
' this produces the "next" permutation
' it allows one to step through all possible iterations without having to have them
' all in memory at the same time
    Dim L As Integer, ii As Integer, jj As Integer
    Dim c() As Byte, temp As Byte

    L = Len(s)

    If StrComp(s, "**done**") = 0 Or StrComp(s, "") = 0 Then
        nextPerm = ""
        Exit Function
    End If

' convert to byte array... more compact to manipulate
    ReDim c(1 To L)
    For ii = 1 To L
        c(ii) = Asc(Mid(s, ii, 1))
    Next ii

' find the largest "tail":
    For ii = L - 1 To 1 Step -1
        If c(ii) < c(ii + 1) Then Exit For
    Next ii

' if we complete the loop without break, ii will be zero
    If ii = 0 Then
        nextPerm = "**done**"
        Exit Function
    End If

' find the smallest value in the tail that is larger than c(ii)
' take advantage of the fact that tail is sorted in reverse order
    For jj = L To ii + 1 Step -1
        If c(jj) > c(ii) Then
            ' swap elements
            temp = c(jj)
            c(jj) = c(ii)
            c(ii) = temp
            Exit For
        End If
    Next jj

' now reverse the characters from ii+1 to the end:
    nextPerm = ""
    For jj = 1 To ii
        nextPerm = nextPerm & Chr(c(jj))
    Next jj
    For jj = L To ii + 1 Step -1
        nextPerm = nextPerm & Chr(c(jj))
    Next jj
End Function

Was muss ich ändern, damit dies funktioniert?

Bernard
quelle
Ich habe wohl vergessen zu fragen: "Was muss ich ändern?"
Bernard
Können Sie ein Beispiel für die Daten geben, für die Sie die Funktion verwenden? Und die erwartete Leistung?
BruceWayne

Antworten:

0

Hier ist die Version für durch Kommas getrennte Listen:

Function nextPerm2(s As String)
' inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
' this produces the "next" permutation
' it allows one to step through all possible iterations without having to have them
' all in memory at the same time
    Dim L As Integer, ii As Integer, jj As Integer
    Dim c() As Variant, temp As Variant

    L = Len(s)

    If StrComp(s, "**done**") = 0 Or StrComp(s, "") = 0 Then
        nextPerm2 = ""
        Exit Function
    End If

' convert to byte array... more compact to manipulate
    arr = Split(s, ",")

    ReDim c(1 To UBound(arr) + 1)
    For ii = 1 To UBound(arr) + 1
        c(ii) = arr(ii - 1)
    Next ii
    L = UBound(arr) + 1
' find the largest "tail":
    For ii = L - 1 To 1 Step -1
        If c(ii) < c(ii + 1) Then Exit For
    Next ii

' if we complete the loop without break, ii will be zero
    If ii = 0 Then
        nextPerm2 = "**done**"
        Exit Function
    End If

' find the smallest value in the tail that is larger than c(ii)
' take advantage of the fact that tail is sorted in reverse order
    For jj = L To ii + 1 Step -1
        If c(jj) > c(ii) Then
            ' swap elements
            temp = c(jj)
            c(jj) = c(ii)
            c(ii) = temp
            Exit For
        End If
    Next jj

' now reverse the characters from ii+1 to the end:
    nextPerm2 = ""
    For jj = 1 To ii
        nextPerm2 = nextPerm2 & c(jj) & ","
    Next jj
    For jj = L To ii + 1 Step -1
        nextPerm2 = nextPerm2 & c(jj) & ","
    Next jj

    If Right(nextPerm2, 1) = "," Then nextPerm2 = Left(nextPerm2, Len(nextPerm2) - 1)
End Function

Das Parsing verwendet Split()und es gibt andere Änderungen.

Nicht vollständig getestet!

Bildbeschreibung hier eingeben

Garys Schüler
quelle
Ich konnte dieses Makro verwenden und alle 120 Permutationen mit 5 Zahlen erhalten. Es wird eine Weile dauern, bis ich Beispiele gefunden und die erforderlichen Schritte überprüft habe, um sie besser zu verstehen. Vielen Dank
Bernard
0

Ich habe den Algorithmus in den ersten Beiträgen nicht geändert:

Ich habe jedoch den VBA-Code geändert, um aussagekräftigere Variablennamen zu erhalten und Begrenzer als Parameter in der Anfangszeichenfolge zuzulassen:


Option Explicit

Public Sub ShowPerm()

    With Sheet1
        .Range("B1") = nextPerm2(.Range("A1"))
        .Range("B2") = nextPerm2(.Range("A2"), " ")
        .Range("B3") = nextPerm2(.Range("A3"), " ")
        .Range("B4") = nextPerm2(.Range("A4"))
    End With

    'if A1 = "3,2,5,4,1"    Then B1 = "3,4,1,2,5"
    'if A2 = "3 222 5 4 1"  Then B2 = "3 4 1 222 5"
    'if A3 = "1"            Then B3 = "**done**"
    'if A4 = "2"            Then B4 = "**done**"

End Sub

Public Function nextPerm2(ByVal strIni As String, _
                          Optional ByVal delim As String = ",") As String

'inspired by http://stackoverflow.com/questions/352203/generating-permutations-lazily
'this produces the "next" permutation it allows one to step through all possible
'iterations without having to have them all in memory at the same time

    Dim arr As Variant, arrSz As Long, i As Long, j As Long, tmp As Byte

    If strIni = "**done**" Or Len(strIni) = 0 Then Exit Function

    arr = Split(strIni, delim)      'convert to array

    arrSz = UBound(arr)

    For i = 0 To arrSz
        arr(i) = Trim(arr(i))       'clean-up white-spaces from each item
    Next i
    For i = arrSz - 1 To 0 Step -1  'find the largest "tail"
        If arr(i) < arr(i + 1) Then Exit For
    Next i
    If i = 0 Or i = -1 Then         'if loop complete, i is 0; if i = -1, arrSz = 0
        nextPerm2 = "**done**"
        Exit Function
    End If

    'find the smallest value in the tail that is larger than arr(i)
    'take advantage of the fact that tail is sorted in reverse order
    For j = arrSz To i + 1 Step -1
        If arr(j) > arr(i) Then     'swap elements
            tmp = arr(j)
            arr(j) = arr(i)
            arr(i) = tmp
            Exit For
        End If
    Next j

    'now reverse the characters from i + 1 to the end
    nextPerm2 = vbNullString
    For j = 0 To i
        nextPerm2 = nextPerm2 & arr(j) & delim
    Next j
    For j = arrSz To i + 1 Step -1
        nextPerm2 = nextPerm2 & arr(j) & delim
    Next j

    nextPerm2 = Left(nextPerm2, Len(nextPerm2) - 1) 'remove last delim

End Function

Paul Bica
quelle
Vielen Dank. Es wird eine Weile dauern, bis ich es überprüft und mit dem Originalcode verglichen habe. Ich sehe, dass Sie es in Array geändert haben und dass Sie für die Permutation geteilt haben und dann das Trennzeichen zurückgeben. Vielen Dank und allen anderen für Ihre Hilfe. Ich bin mir sicher, dass ich zurückkommen werde, um weitere Ratschläge zu erhalten.
Bernard
Ja - das ursprüngliche Byte-Array passte nicht zu diesem Modell (@Gary verwendete denselben Ansatz)
paul bica
Ich bin mir nicht sicher, ob ich etwas falsch mache, aber ich konnte nur die ersten 24 Permutationen ab der ersten Zahl erhalten.
Bernard