Note: The other languages of the website are Google-translated. Back to English

كيفية إنشاء أو سرد كافة التباديل الممكنة في 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 يومًا.
علامة تبويب kte 201905

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

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

أحاول الحصول على تبديل لـ 82 حرفًا ، يعمل الكود المقدم ، ولكن نظرًا لأن الأعمدة هي 1048576 فقط ، فأنا أريد نقل الإخراج التالي في B ، C ، D ..... هل يمكن لأي منكم مساعدتي في هذا اعتبار
تم تصغير هذا التعليق بواسطة المشرف على الموقع
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)
التالى
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كم عدد التسلسلات المكونة من 3 أشياء يمكن تشكيلها من 7 أشياء مختلفة ، الاستبدال والترتيب مهم؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
3 أس 7: 2187
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أهلا بالجميع. أنا بحاجة إلى مساعدة في هذا الشأن. لدي حرفان أبجديان يتم تبديلهما في 20 صفًا. لكنني لا أفهمها بشكل صحيح. يجب على أي شخص يمكنه مساعدتي إرسال التقليب إلى بريدي الإلكتروني. pauladah69@gmail.com.


1. أبا
2-عاب
3-عاب
4-عاب
5-عاب
6-عاب
7-عاب
8-عاب
9-عاب
10-عاب
11-عاب
12-عاب
13-عاب
14-عاب
15-عاب
16-عاب
17-عاب
18-عاب
19-عاب
20-عاب
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لن يعمل هذا الرمز نظرًا لوجود نوعين من التباديل


يجب ان يكون:

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


HTH
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، MC ،
أشكركم على تذكيركم الحار ، إنه خطأي. لقد صححتها.
وبفضل الكثير!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
peki bunu listeleyecek bir program uygulama yok mu؟ basit sıradan bir hesaplamadan daha fazlasına ihtiyacı olan ne yapacak؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
من يمكنه أن يرسل لي قائمة من 10 عناصر مختلفة تتناوب مع نتيجتين. هذا الكود

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

'===========================
لأني = 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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا !

Como faço para gerar pelo menos 10 permutações؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا يا ماتيوس ،
لحل مشكلتك ، يرجى تطبيق الكود أدناه: (ملاحظة: إذا كان هناك أكثر من 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   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL