Código VBA: Wymień todas jako permutações possíveis no exces

Cześć Angeliton,

Widziałem twój kod, ale nie do końca cię rozumiem. Czy mówisz po angielsku?

Amanda

Ten kod VBA: wypisz wszystkie możliwe permutacje w Excelu, potrzebuję w nim modyfikacji w postaci danych wejściowych, które znajdują się w „MsgBox” i potrzebuję go w zaznaczeniu 1 kolumny oraz ilości wierszy w wybranym linii i możliwość dokonania modyfikacji w kodzie.
odpowiedz odpowiedz
Wychodzi „MsgBox”, „Zbyt wiele permutacji!”, vbInformation, „Kutools for Excel” „Który jest tylko digitalizowany, a nie przez wybór
Wpisz „1 wybór kolumny/wierszy”.
przykład
wiersze wybranej kolumny 12345678 5 z 8 kontynuuje w ten sposób w kodzie.
zaczyna się 12345
kończy się na 87654. wprowadzanie danych obserwacyjnych poprzez wybór w kolumnie

Cześć Angeliton,

Tak mi przykro, że nie mogłem cię w pełni zrozumieć... Mam nadzieję, że możesz zreorganizować słowo.

Z góry dziękuję.
Amanda

Cześć Amanda Lee, ten kod zawiera dane wejściowe do wymiany/możliwe kombinacje w MsgBox „Zbyt wiele permutacji!”, vbInformation, „Kutools for Excel”
Potrzebuję zamiany danych wejściowych/możliwych kombinacji w wyborze kolumn.
przykład
kolumna 1
1 linia = biały
2 linie = czarny
3 Linia = niebieski
4 linie = żółty
5 linii = zielony
Te linie zostaną zamienione we wszystkich możliwych kombinacjach, kod już to robi, więc nie mogę wybrać linii permutacji, ponieważ dane wejściowe to MsgBox, który jest wpisany i nie wybrany.
pełny kod jest tutaj: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,

Cześć Angeliton,

Przepraszam za późną odpowiedź.

Wypróbuj poniższy kod: (Zauważ, że kod nie przetwarza ciągu zawierającego więcej niż 8 znaków. Jeśli chcesz zwiększyć liczbę, możesz zmienić liczbę 8 w „If Len(xStr) >= 8 Then” w kod na większe liczby. Jednak im większa liczba, tym wolniejszy byłby program.)

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

Mam nadzieję, że to działa dla ciebie.

Amanda