신제품

Código VBA: permutações possíveis no exce로 todas를 나열하십시오.

  뛰어나다
안젤리톤
  안젤리톤
  수요일 29 12월 2021
  5 답글
  7.7K 방문
0
투표
취소
Este Código VBA: Liste todas as permutações possíveis no Excel, preciso de uma modificão nele na forma de entrada, que está em 'MsgBox' e eu preciso que seja em uma seleção de 1 coluna, ea a 퀀티데이드 de linha dentro das linhas selecionadas, e possivel fazer a  modificação no código.
Sai 'MsgBox "순열이 너무 많습니다!", vbInformation, "Excel용 Kutools"' Que é somente digitável e não por seleção
Entra 'seleção de 1 coluna/linhas.
예
linhas selecionadas 12345678 permutar 5 das 8 continueando como esta no codigo.
코카 12345
'em 87654를 종료합니다.

'Sub
GetString()

'Updateby Extendoffice

    
Dim
xStr 
As
String

    
Dim
FRow 
As
Long

    
Dim
xScreen 
As
Boolean

    
xScreen = Application.ScreenUpdating

    
Application.ScreenUpdating = 
False

    
xStr = Application.InputBox(
"Enter text to permute:"
, 
"Kutools for Excel"
, , , , , , 2)

    
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
0
오래된 것을 처음으로  
아만다 리
아만다 리
2 년 전
·
#2419
0
투표
취소
안녕하세요, 엔젤리톤님,

귀하의 코드를 보았지만 귀하의 말을 잘 이해하지 못합니다. 영어를 할 수 있나요?

아만다
안젤리톤
안젤리톤
2 년 전
·
#2420
0
투표
취소
이 VBA 코드는 다음과 같습니다. Excel에서 가능한 모든 순열을 나열합니다. 'MsgBox'에 있는 입력 형식으로 수정이 필요하며 1개 열을 선택하고 선택한 열 내에서 행의 양을 선택해야 합니다. 라인, 코드 수정이 가능합니다.
답장하다
'MsgBox', "순열이 너무 많습니다!", vbInformation, "Excel용 Kutools"'를 종료합니다. 선택 사항이 아닌 디지털화만 가능합니다.
'1개의 열/행 선택을 입력하세요.
예
선택된 열 12345678의 행 5개 중 8개가 코드에서 이와 같이 계속됩니다.
12345 시작
87654로 끝납니다. 열에서 선택하여 관측 데이터 입력
아만다 리
아만다 리
2 년 전
·
#2421
0
투표
취소
안녕하세요, Angeliton님,

완전히 이해하지 못해서 너무 죄송합니다... 단어를 다시 정리하시길 바랍니다.

사전에 감사합니다.
아만다
안젤리톤
안젤리톤
2 년 전
·
#2422
0
투표
취소
안녕하세요 Amanda Lee, 이 코드에는 MsgBox "순열이 너무 많습니다!", vbInformation, "Kutools for Excel"에서 교환할 입력 데이터/가능한 조합이 있습니다.
열 선택에서 교환/가능한 조합을 위해 입력 데이터가 필요합니다.
예
열 1
1줄 = 흰색
2줄 = 검정색
3라인 = 파란색
4줄 = 노란색
5선 = 녹색
이 줄은 가능한 모든 조합으로 바뀔 것입니다. 코드는 이미 그렇게 하고 있으므로 입력이 입력되고 선택되지 않은 MsgBox이기 때문에 순열 줄을 선택할 수 없습니다.
전체 코드는 여기에 있습니다: https://www.extendoffice.com/documents/excel/3657-excel-generate-all-permutations.html
,
아만다 리
아만다 리
2 년 전
·
#2423
0
투표
취소
안녕하세요, 엔젤리톤님,

늦은 답변 죄송합니다.

아래 코드를 시도해 보십시오: (코드는 8자를 초과하는 문자열을 처리하지 않습니다. 숫자를 더 크게 만들고 싶다면 "If Len(xStr) >= 8 Then"의 숫자 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


희망이 당신을 위해 작동합니다.

아만다
  • 페이지 :
  • 1
이 게시물에 대한 답변이 없습니다.