如何使用 VBA 在 Excel 的 5 列中获得“是”和“否”的排列？

Question

I need to list all the permutations of Yes/No across five columns. For example, {Yes,Yes,Yes,Yes,Yes}, {Yes,Yes,Yes,Yes,No}, {Yes,Yes,Yes,No,No}, {Yes,Yes,No,No,No}, etc... see this screenshot

Problem is I only came up with those few and I think the total is 120... Is there some VBA code I can run to get ALL the permutations?

Answer 1

You don't need VBA to do this. The following worksheet formula gets you there.

Select cell B2 and paste this formula:

=CHOOSE(1+MID(LEFT("00000",5-LEN(DEC2BIN(32-ROW()+1)))&DEC2BIN(32-ROW()+1),COLUMN()-1,1),"No","Yes")

Now copy that formula to this range: B2:F33

That's it.

Of course, afterward, you may want to copy the results and Paste As Values to have hard values in the cells instead of formulas.

---

And here is how to do it in VBA, should you prefer a coded solution:

Option Explicit

Sub DisplayYesNoPerms()
    Dim rows&, cols&
    cols = 5
    rows = 2 ^ cols
    [b2].Resize(rows, cols) = YesNoPerms(rows, cols)
End Sub

Function YesNoPerms(rows&, cols&)
    Dim i&, j&, t$, v
    ReDim v(0 To rows - 1, 1 To cols)
    For i = 0 To rows - 1
        t = Format(DecToBin(i), String(cols, "0"))
        For j = 1 To cols
            v(i, j) = IIf(Mid(t, j, 1), "No", "Yes")
        Next
    Next
    YesNoPerms = v
End Function

Function DecToBin$(ByVal n&)
    Do
        DecToBin = n Mod 2 & DecToBin
        n = n \ 2
    Loop While n
End Function

Answer 2

I won't give you a VBA solution, but an algorithm that you can implement: just think of every "No" as a number 0, and a "Yes" as a number 1. You create all numbers in the binary system, from "00000" to "11111" (so from 0 to 31).

So, what you need to do:

You take every number from 0 to 31, and for every number:
  You convert it into binary format.
  In that binary format, replace every 0 by a "No" and every 1 by a "Yes".
  Find a way to fill your Excel sheet with the corresponding results.

Good luck

Answer 3

This should print all combinations to the respective rows/columns. User is required to select the top left cell just below the header.

Dim i As Long, ii As Long, iii As Long, iiii As Long, iiiii As Long
Dim j As Long, jj As Long
Dim str As String
Dim rng As Range
Dim arr(1) As String
arr(0) = "yes"
arr(1) = "no"
Dim arr_rows() As String
Dim arr_columns() As String

' five nested loops (each for a column)
' the idea is to have all possibilities (yes or no) covered
' each row is taken care of by adding vbNewLine
For i = LBound(arr) To UBound(arr)
 For ii = LBound(arr) To UBound(arr)
  For iii = LBound(arr) To UBound(arr)
   For iiii = LBound(arr) To UBound(arr)
    For iiiii = LBound(arr) To UBound(arr)
     str = str & arr(i) & "," & arr(ii) & "," & arr(iii) & "," & arr(iiii) & "," & arr(iiiii) & vbNewLine
    Next iiiii
   Next iiii
  Next iii
 Next ii
Next i

' splitting the string created in the loop by new line character
' (i.e. obtaining an array with an element for each row)
' for each row splitting by a comma
' (i.e. obtaining another array with an element for each column)
arr_rows = Split(str, vbNewLine)
Set rng = Selection
For j = LBound(arr_rows) To UBound(arr_rows)
    arr_columns = Split(arr_rows(j), ",")
    For jj = LBound(arr_columns) To UBound(arr_columns)
        rng.Offset(j, jj) = arr_columns(jj)
    Next jj
Next j