لیست ترکیبات در اکسل

Question

رون می‌داند که می‌تواند از تابع COMBIN برای تعیین تعداد ترکیب‌هایی که می‌توان از تعدادی رقم ایجاد کرد استفاده کرد. با این حال، او متعجب است که آیا راهی برای فهرست کردن همه ترکیبات وجود دارد.

هیچ راهی داخلی برای فهرست کردن ترکیبات در اکسل وجود ندارد. با این حال، می توانید یک ماکرو ایجاد کنید تا لیست را برای شما انجام دهد. اگر می‌خواهید ترکیب‌های منحصربه‌فرد را در مجموعه‌ای از اعداد متوالی که از 1 شروع می‌شوند پیدا کنید، مجموعه ماکروهای زیر این کار را انجام می‌دهند. تنها کاری که باید انجام دهید این است که تابع TestCNR را اجرا کنید و در نهایت با یک "ماتریس" از سلول ها مواجه خواهید شد که تعداد ترکیبات 4 رقمی را در مجموعه مقادیر متوالی از 1 تا 10 نشان می دهد.

Sub TestCNR()
    Cnr 10, 4
End Sub

Sub Cnr(n, r)
    i = 1
    For j = 1 To r
        Cells(i, j).Value = j
    Next

    Do Until Finished(n, r, i)
        j = FindFirstSmall(n, r, i)
        For k = 1 To j — 1
            Cells(i + 1, k).Value = Cells(i, k).Value
        Next
        Cells(i + 1, j).Value = Cells(i, j).Value + 1
        For k = j + 1 To r
            Cells(i + 1, k).Value = Cells(i + 1, k - 1).Value + 1
        Next
        i = i + 1
    Loop
End Sub

Function Finished(n, r, i)
    Temp = True

    For j = r To 1 Step -1
        If Cells(i, j).Value <> j + (n - r) Then
            Temp = False
        End If
    Next
    Finished = Temp
End Function

Function FindFirstSmall(n, r, i)
    j = r
    Do Until Cells(i, j).Value <> j + (n - r)
        j = j - 1
    Loop
    FindFirstSmall = j
End Function

ماکرو هر چیزی را که در کاربرگ شما وجود دارد رونویسی می کند، بنابراین مطمئن شوید که آزمون را با یک کاربرگ خالی نمایش داده شده اجرا کنید. اگر می خواهید اندازه مجموعه یا تعداد عناصر زیر مجموعه را تغییر دهید، فقط مقادیر ارسال شده در روتین TestCNR را تغییر دهید.

اگر می‌خواهید ترکیب‌های منحصربه‌فردی را از یک رشته کاراکتر (مثلاً حروف الفبا) بیرون بکشید، باید از مجموعه‌ای متفاوت از ماکروها استفاده کنید. موارد زیر به خوبی کار خواهند کرد؛ فرض بر این است که کاراکترهایی که می خواهید به عنوان "جهان" خود استفاده کنید در سلول A1 و عددی که در هر ترکیب منحصر به فرد می خواهید در سلول A2 باشد.

Sub FindSets()
    Dim iA() As Integer
    Dim sUniv As String
    Dim iWanted As Integer
    Dim j As Integer
    Dim k As Integer

    sUniv = Cells(1, 1).Value
    iWanted = Cells(2, 1).Value

    ReDim iA(iWanted)
    For j = 1 To iWanted
        iA(j) = j
    Next j

    iRow = PutRow(iA, sUniv, 1)

    Do Until DoneYet(iA, Len(sUniv))
        j = WorkHere(iA, Len(sUniv))
        iA(j) = iA(j) + 1
        For k = j + 1 To iWanted
            iA(k) = iA(k - 1) + 1
        Next k
        iRow = PutRow(iA, sUniv, iRow)
    Loop
End Sub

Function DoneYet(iB, n) As Boolean
    iMax = UBound(iB)
    Temp = True
    For j = iMax To 1 Step -1
        If iB(j) <> j + (n - iMax) Then
            Temp = False
        End If
    Next
    DoneYet = Temp
End Function

Function WorkHere(iB, n) As Integer
    iMax = UBound(iB)
    j = iMax
    Do Until iB(j) <> j + (n - iMax)
        j = j - 1
    Loop
    WorkHere = j
End Function

Function PutRow(iB, sUniv, i)
    iMax = UBound(iB)
    sTemp = ""
    For j = 1 To iMax
        sTemp = sTemp & Mid(sUniv, iB(j), 1)
    Next j
    Cells(i, 2).Value = sTemp
    PutRow = i + 1
End Function

ماکرو FindSets را اجرا کنید و ترکیب های مختلف مورد نظر به ستون 2 ختم می شوند. با این حال، هنگام اجرای ماکرو مراقب باشید. تعداد ترکیب ها می تواند خیلی سریع زیاد شود.