Código VBA: Καταχωρίστε τα todas ως permutações possíveis no exce

Γεια σου Angeliton,

Είδα τον κωδικό σου, αλλά δεν σε καταλαβαίνω καλά. Μπορείς να μιλήσεις αγγλικά?

Amanda

Αυτός ο κώδικας VBA: Καταχωρίστε όλες τις πιθανές μεταθέσεις στο Excel, χρειάζομαι μια τροποποίηση σε αυτό με τη μορφή εισαγωγής, η οποία βρίσκεται στο "MsgBox" και πρέπει να είναι σε μια επιλογή 1 στήλης και το ποσό της γραμμής εντός του επιλεγμένου γραμμές και είναι δυνατό να γίνει η τροποποίηση στον κώδικα.
απάντηση απάντηση
Έξοδος από "MsgBox", "Too many permutations!", vbInformation, "Kutools for Excel"" Το οποίο είναι μόνο ψηφιοποιημένο και όχι από επιλογή
Εισαγάγετε την επιλογή '1 στήλη/γραμμές.
παράδειγμα
σειρές μιας επιλεγμένης στήλης 12345678 5 από τις 8 συνεχίζουν έτσι στον κώδικα.
ξεκινά 12345
τελειώνει σε 87654. εισαγωγή δεδομένων παρατήρησης με επιλογή στη στήλη

Γεια σου Angeliton,

Λυπάμαι πολύ που δεν μπόρεσα να σας καταλάβω πλήρως... Ελπίζω να μπορέσετε να αναδιοργανώσετε τη λέξη.

Ευχαριστώ εκ των προτέρων.
Amanda

Γεια σου Amanda Lee, αυτός ο κωδικός έχει δεδομένα εισόδου προς ανταλλαγή / πιθανούς συνδυασμούς στο MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
Χρειάζομαι δεδομένα εισόδου για ανταλλαγή/πιθανούς συνδυασμούς στην επιλογή στηλών.
παράδειγμα
στήλη 1
1 γραμμή = λευκό
2 γραμμή = μαύρο
3 Γραμμή = μπλε
4 γραμμή = κίτρινο
5 γραμμή = πράσινο
Αυτές οι γραμμές θα εναλλάσσονται σε όλους τους πιθανούς συνδυασμούς, ο κώδικας το κάνει ήδη, οπότε δεν μπορώ να επιλέξω τις γραμμές μετάθεσης, επειδή η είσοδος είναι ένα MsgBox που πληκτρολογείται και δεν επιλέγεται.
ο πλήρης κωδικός είναι εδώ: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,

Γεια σου Angeliton,

Συγγνώμη για την καθυστερημένη απάντηση.

Δοκιμάστε τον παρακάτω κωδικό: (Σημειώστε ότι ο κωδικός δεν επεξεργάζεται μια συμβολοσειρά με περισσότερους από 8 χαρακτήρες. Εάν θέλετε να μεγαλώσετε τον αριθμό, μπορείτε να αλλάξετε τον αριθμό 8 του "If Len(xStr) >= 8 Τότε" στο κωδικός σε μεγαλύτερους αριθμούς. Ωστόσο, όσο μεγαλύτερος είναι ο αριθμός, τόσο πιο αργό θα ήταν το πρόγραμμα.)

Sub GetString()

'Updateby Extendoffice

Dim xStr As String

Dim FRow As Long

Dim xScreen As Boolean

Dim Rg, xRg As Range

xScreen = Application.ScreenUpdating

Application.ScreenUpdating = False

Set xRg = Application.InputBox("Enter text to permute:", "Kutools for Excel", , , , , , 8)

xStr = ""

For Each Rg In xRg

xStr = xStr + Rg.Text

Next

If Len(xStr) < 2 Then Exit Sub

If Len(xStr) >= 8 Then

MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"

Exit Sub

Else

ActiveSheet.Columns(1).Clear

FRow = 1

Call GetPermutation("", xStr, FRow)

End If

Application.ScreenUpdating = xScreen

End Sub

Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long)

Dim i As Integer, xLen As Integer

xLen = Len(Str2)

If xLen < 2 Then

Range("A" & xRow) = Str1 & Str2

xRow = xRow + 1

Else

For i = 1 To xLen

Call GetPermutation(Str1 + Mid(Str2, i, 1), Left(Str2, i - 1) + Right(Str2, xLen - i), xRow)

Next

End If

End Sub

Ελπίζω αυτό να λειτουργεί για εσάς.

Amanda