جديد

Código VBA: Liste todas كما هو مسموح به ليس هناك ما يكفي

  Excel
أنجليتون
  أنجليتون
  الأربعاء، 29 ديسمبر 2021
  5 الردود
  7.8 ألف زيارة
0
الأصوات
فك
Este Código VBA: Liste todas as permutações likis no Excel، preciso de uma modificão nele na forma de entrada، que está em 'MsgBox' eu preciso que seja em uma seleção de 1 coluna، ea quantidade de linha dentro das linhas يمكن تعديلها لا código.
Sai 'MsgBox "الكثير من التباديل!" ، vbInformation ، "Kutools for Excel"' Que é somente digitável e não por seleção
Entra 'seleção de 1 coluna / linhas.
مثال
linhas selecionadas 12345678 permutar 5 das 8 Continando como esta no codigo.
يأتيك 12345
'ترمينا م 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
الأصوات
فك
رمز فبا هذا: أدرج جميع التباديل الممكنة في Excel ، أحتاج إلى تعديل فيه في شكل إدخال ، الموجود في "MsgBox" وأريد أن يكون في مجموعة مختارة من عمود واحد ، ومقدار الصف داخل المحدد ويمكن إجراء التعديل في الكود.
الرد الرد
يخرج "MsgBox" ، "عدد كبير جدًا من التباديل!" ، vbInformation ، "Kutools for Excel" "والذي يتم ترقيمه فقط وليس عن طريق التحديد
أدخل '1 عمود / صفوف التحديد.
مثال
صفوف العمود المحدد 12345678 5 من 8 مستمرة على هذا النحو في الكود.
يبدأ 12345
تنتهي في 87654. إدخال بيانات المراقبة بالاختيار في العمود
أماندا لي
أماندا لي
منذ سنوات 2
·
#2421
0
الأصوات
فك
مرحبًا أنجيليتون ،

آسف جدًا لأنني لم أستطع فهمك تمامًا ... آمل أن تتمكن من إعادة تنظيم الكلمة.

شكرا مقدما.
أماندا
أنجليتون
أنجليتون
منذ سنوات 2
·
#2422
0
الأصوات
فك
مرحبًا أماندا لي ، يحتوي هذا الرمز على بيانات إدخال ليتم تبادلها / مجموعات محتملة في 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 أحرف. إذا كنت تريد تكبير الرقم ، فيمكنك تغيير الرقم 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


أتمنى أن يكون هذا مناسبا لك.

أماندا
  • الصفحة:
  • 1
لا توجد ردود لهذا المنصب حتى الآن.