ใหม่

Código VBA: แสดงรายการ todas เป็น permutações possíveis no exce

  Excel
แองเจลิตัน
  แองเจลิตัน
  วันพุธที่ 29 2021 ธันวาคม
  5 ตอบกลับ
  เยี่ยมชม 8 พันครั้ง
0
โหวต
แก้
Este Código VBA: แสดงรายการ 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 colunada s quantidades possivel fazer และ modificação no código.
Sai 'MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"' Que é somente digitável และ não por seleção
Entra 'seleção de 1 coluna/linhas. เข้าสู่ระบบ
แบบอย่าง
linhas selecionadas 12345678 เรียงต่อ 5 das 8 ต่อเนื่องและ como esta no codigo.
começa12345
ปลายทาง 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, "Kutools for Excel"' ซึ่งถูกแปลงเป็นดิจิทัลเท่านั้น ไม่ใช่โดยการเลือก
ป้อน 'การเลือก 1 คอลัมน์/แถว
ตัวอย่าง
แถวของคอลัมน์ที่เลือก 12345678 5 จาก 8 แถวต่อแบบนี้ในโค้ด
เริ่ม 12345
สิ้นสุดใน 87654 การป้อนข้อมูลการสังเกตโดยการเลือกในคอลัมน์
อแมนดาลี
อแมนดาลี
2 ปีที่ผ่านมา
·
#2421
0
โหวต
แก้
สวัสดีแองเจลิตัน

ขออภัยที่ฉันไม่เข้าใจคุณอย่างถ่องแท้... หวังว่าคุณจะสามารถจัดระเบียบคำใหม่ได้

ขอบคุณล่วงหน้า
อแมนดา
แองเจลิตัน
แองเจลิตัน
2 ปีที่ผ่านมา
·
#2422
0
โหวต
แก้
สวัสดี Amanda Lee รหัสนี้มีข้อมูลอินพุตที่จะแลกเปลี่ยน / ชุดค่าผสมที่เป็นไปได้ใน MsgBox "การเรียงสับเปลี่ยนมากเกินไป!", vbInformation, "Kutools สำหรับ 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 Then" ใน รหัสเป็นตัวเลขที่มากขึ้น อย่างไรก็ตาม ยิ่งตัวเลขมาก โปรแกรมก็จะช้าลง)

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
ไม่มีคำตอบสำหรับโพสต์นี้