كيفية إنشاء أو سرد كافة التباديل الممكنة في Excel؟

على سبيل المثال ، لدي ثلاثة أحرف XYZ ، الآن ، أريد سرد جميع التباديل الممكنة بناءً على هذه الأحرف الثلاثة للحصول على ست نتائج مختلفة على النحو التالي: XYZ و XZY و YXZ و YZX و ZXY و ZYX. في Excel ، كيف يمكنك إنشاء أو سرد كافة التباديل بسرعة بناءً على عدد مختلف من الأحرف؟

قم بإنشاء أو سرد كافة التباديل الممكنة بناءً على أحرف برمز VBA

قم بإنشاء أو سرد كافة التباديل الممكنة بناءً على أحرف برمز VBA

قد يساعدك رمز VBA التالي في سرد جميع التباديل بناءً على عدد الأحرف المحدد الخاص بك ، يرجى القيام بما يلي:

1. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة، والصق الكود التالي في ملف وحدة نافذة او شباك.

كود فبا: ضع قائمة بجميع التبديلات الممكنة في إكسل

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

3. ثم اضغط F5 مفتاح لتشغيل هذا الرمز ، ويظهر مربع موجه لتذكيرك بإدخال الأحرف التي تريد إدراج جميع التباديل فيها ، انظر لقطة الشاشة:

تبديلات قائمة المستندات 1

4. بعد إدخال الأحرف ، ثم انقر فوق OK زر ، يتم عرض جميع التباديل الممكنة في العمود A من ورقة العمل النشطة. انظر لقطة الشاشة:

تبديلات قائمة المستندات 2

ملاحظة: إذا كان طول الحرف الذي تم إدخاله يساوي أو يزيد عن 8 أحرف ، فلن يعمل هذا الرمز نظرًا لوجود عدد كبير جدًا من التبديلات.

تبديلات قائمة المستندات 3

سرد أو إنشاء كل المجموعات الممكنة من أعمدة متعددة

إذا كنت بحاجة إلى إنشاء جميع المجموعات الممكنة بناءً على بيانات أعمدة متعددة ، فربما لا توجد طريقة جيدة للتعامل مع المهمة. لكن، كوتولس ل إكسيل's سرد كافة المجموعات يمكن أن تساعدك الأداة على سرد كافة التركيبات الممكنة بسرعة وسهولة. انقر لتنزيل Kutools for Excel!

قائمة doc بجميع المجموعات

كوتولس ل إكسيل: مع أكثر من 300 وظيفة إضافية مفيدة في Excel ، يمكنك تجربتها مجانًا دون قيود خلال 30 يومًا. تنزيل وتجربة مجانية الآن!

أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.

اقرأ أكثر... تحميل مجاني ... شراء...

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!

اقرأ أكثر... تحميل مجاني ... شراء...

التعليقات (13)

لا يوجد تقييم. كن أول من يقيم!

تيرينس

منذ حوالي 5 سنوات

#18509

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبًا ، أنا أقوم بمشروع صغير باستخدام قواعد التبديل والجمع. أحتاج إلى دعمكم في هذا من فضلك. السيناريو: لدي بيانات أبجدية رقمية مكونة من 13 رقمًا (00SHGO8BJIDG0) أريد تشفيرًا للتبادل S إلى 5 و I إلى 1 و O إلى 0 والعكس صحيح. المشروع هو أنه إذا كان لدي البيانات الصحيحة المكونة من 13 رقمًا ، فسوف أتلقى رمز مرور مكونًا من 3 أرقام. (على سبيل المثال) 00SHG08BJ1DG0 - 500 هو رمز المرور ولكن بسبب خطأ مطبعي بدلاً من 1 كان أنا و 0 كان هناك معلومات خاطئة. هل تستطيع مساعدتي رجاء.

رد

سوبراجا

منذ حوالي 5 سنوات

#21554

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبا،

أحاول الحصول على تبديل لـ 82 حرفًا ، يعمل الكود المقدم ، ولكن نظرًا لأن الأعمدة هي 1048576 فقط ، فأنا أريد نقل الإخراج التالي في B ، C ، D ..... هل يمكن لأي منكم مساعدتي في هذا اعتبار

رد

ديكلان كيو

منذ حوالي 5 سنوات

#21598

تم تصغير هذا التعليق بواسطة المشرف على الموقع

MustafaHosny اللهم امين ...

في الجزء الفرعي الأول امسح جميع الخلايا ... وليس الصف الأول فقط
- الخلايا. واضحة

Sub GetPermutation (Str1 as String ، Str2 as String ، ByRef xRow As Long)
Dim i As Integer ، xLen As Integer
xLen = لين (Str2)
إذا كان xLen <2 ثم
انتقل إلى العمود التالي عندما تصل إلى 100
الخلايا (((xRow - 1) Mod 100) + 1، 1 + Int (xRow / 100)) = Str1 & Str2
xRow = xRow + 1
آخر
لأني = 1 إلى xLen
استدعاء GetPermutation (Str1 + Mid (Str2، i، 1)، يسار (Str2، i - 1) + يمين (Str2، xLen - i)، xRow)
التالى
إنهاء حالة
نهاية الفرعية

رد

بلغ

Wule

منذ حوالي 4 سنوات

#25048

تم تصغير هذا التعليق بواسطة المشرف على الموقع

كم عدد التسلسلات المكونة من 3 أشياء يمكن تشكيلها من 7 أشياء مختلفة ، الاستبدال والترتيب مهم؟

رد

ضيف Wule

منذ حوالي 4 سنوات

#25049

تم تصغير هذا التعليق بواسطة المشرف على الموقع

3 أس 7: 2187

رد

بول

منذ حوالي 4 سنوات

#25087

تم تصغير هذا التعليق بواسطة المشرف على الموقع

أهلا بالجميع. أنا بحاجة إلى مساعدة في هذا الشأن. لدي حرفان أبجديان يتم تبديلهما في 20 صفًا. لكنني لا أفهمها بشكل صحيح. يجب على أي شخص يمكنه مساعدتي إرسال التقليب إلى بريدي الإلكتروني. pauladah69@gmail.com.

1. أبا
2-عاب
3-عاب
4-عاب
5-عاب
6-عاب
7-عاب
8-عاب
9-عاب
10-عاب
11-عاب
12-عاب
13-عاب
14-عاب
15-عاب
16-عاب
17-عاب
18-عاب
19-عاب
20-عاب

رد

منذ حوالي 3 سنوات

#29084

تم تصغير هذا التعليق بواسطة المشرف على الموقع

لن يعمل هذا الرمز نظرًا لوجود نوعين من التباديل

يجب ان يكون:

لن يعمل هذا الرمز نظرًا لوجود عدد كبير جدًا من التباديل

HTH

رد

سكايانغ MC

منذ حوالي 3 سنوات

#29085

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبًا ، MC ،
أشكركم على تذكيركم الحار ، إنه خطأي. لقد صححتها.
وبفضل الكثير!

رد

بلغ

الهان

منذ حوالي 3 سنوات

#29367

تم تصغير هذا التعليق بواسطة المشرف على الموقع

peki bunu listeleyecek bir program uygulama yok mu؟ basit sıradan bir hesaplamadan daha fazlasına ihtiyacı olan ne yapacak؟

رد

lyto

منذ حوالي 3 سنوات

#29918

تم تصغير هذا التعليق بواسطة المشرف على الموقع

من يمكنه أن يرسل لي قائمة من 10 عناصر مختلفة تتناوب مع نتيجتين. هذا الكود

snt العمل على هذا

رد

DVdm

منذ حوالي 2 سنوات

#32450

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبًا ، إذا كانت سلسلة الإدخال تحتوي على أحرف مكررة ، فإن المجموعة الفرعية تنتج تباديل مكرر.
لا يحدث هذا إذا قمت بإجراء التعديل التالي على الحلقة:

'===========================
لأني = 1 إلى xLen
إذا كان Instr (يسار (Str2، i - 1)، منتصف (Str2، i، 1)) = 0 ثم
استدعاء GetPermutation (Str1 + Mid (Str2، i، 1)، يسار (Str2، i - 1) + يمين (Str2، xLen - i)، xRow)
نهاية إذا
التالى
'===========================

إنشاء متغيرات محلية مؤقتة لـ Mid (Str2، i، 1) ولليسار (Str2، i - 1) ، وتجنب اختبار i = 1 يجعل الأمر أسرع:

'===========================
Sub GetPermutation (Str1 as String ، Str2 as String ، ByRef xRow As Long)
Dim i As Integer ، xLen As Integer ، Str2left as String ، c as String
xLen = لين (Str2)
إذا كان xLen <2 ثم
النطاق ("A" & xRow) = Str1 & Str2
xRow = xRow + 1
آخر
استدعاء GetPermutation (Str1 + Mid (Str2، 1، 1)، Right (Str2، xLen - 1)، xRow)
لأني = 2 إلى xLen
ج = منتصف (Str2، i، 1)
Str2left = يسار (Str2، i - 1)
إذا كان Instr (Str2left، c) = 0 ثم
استدعاء GetPermutation (Str1 + c، Str2left + Right (Str2، xLen - i)، xRow)
إنهاء حالة
التالى
إنهاء حالة
نهاية الفرعية
'===========================

هتاف،
DVdm

رد

بلغ

ماتيوس

منذ حوالي 5 أشهر

#39829

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبا !

Como faço para gerar pelo menos 10 permutações؟

رد

سكايانغ ماتيوس

منذ حوالي 4 أشهر

#39869

تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبًا يا ماتيوس ،
لحل مشكلتك ، يرجى تطبيق الكود أدناه: (ملاحظة: إذا كان هناك أكثر من 8 أحرف ، فسيتم تنفيذ الكود ببطء.)

Sub GetString()
'Updateby Extendoffice
    Dim xStr As String
    Dim FRow As Long
    Dim FC As Integer
    Dim xScreen As Boolean
    Dim xNumber As Long
    xNumber = 10 ' This is the max length of the characters you can change it to 11, 12, 13...as you need
    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) > xNumber Then
        MsgBox "Too many permutations!", vbInformation, "Kutools for Excel"
        Exit Sub
    Else
        ActiveSheet.Columns(1).Clear
        FRow = 1
        FC = 1
        Call GetPermutation("", xStr, FRow, FC)
    End If
    Application.ScreenUpdating = xScreen
End Sub
Sub GetPermutation(Str1 As String, Str2 As String, ByRef xRow As Long, ByRef xc As Integer)
    Dim i As Integer, xLen As Integer
    xLen = Len(Str2)
    If xLen < 2 Then
        If xRow > 1000000 Then
            xc = xc + 1
            xRow = 1
        End If
       ActiveSheet.Cells(xRow, xc) = 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, xc)
        Next
    End If
End Sub

يرجى المحاولة ، آمل أن يساعدك!

رد

بلغ

لا توجد تعليقات منشورة هنا حتى الآن

اترك تعليقاتك

النشر كضيف

الدخول

الاسم (مطلوب)

البريد الإلكتروني (مطلوب)

قيم المنشور:

إعادة تعيين

0 الشخصيات

أنا أوافق على أحكام وشروط