Loncat ke daftar isi utama

Bagaimana cara membuat daftar semua kemungkinan kombinasi dari satu kolom di Excel?

Jika Anda ingin mengembalikan semua kemungkinan kombinasi dari data kolom tunggal untuk mendapatkan hasil seperti gambar di bawah ini, apakah Anda memiliki cara cepat untuk menangani tugas ini di Excel?

Daftar semua kemungkinan kombinasi dari satu kolom dengan rumus

Daftar semua kemungkinan kombinasi dari satu kolom dengan kode VBA

Daftar semua kemungkinan kombinasi dari satu kolom dengan rumus

Rumus array berikut dapat membantu Anda mencapai pekerjaan ini, lakukan langkah demi langkah:

1. Pertama, Anda harus membuat dua sel formula pembantu. Di sel C1, masukkan rumus di bawah ini, dan tekan Ctrl + Shift + Enter kunci untuk mendapatkan hasil:

=MAX(LEN(A2:A6))
Note: Dalam rumus ini, A2: A6 adalah daftar sel yang ingin Anda daftarkan kombinasinya.

2. Di sel C2, masukkan rumus berikut, dan tekan Ctrl + Shift + Enter kunci bersama untuk mendapatkan hasil kedua, lihat tangkapan layar:

=CONCAT(A2:A6&REPT(" ",C2-LEN(A2:A6)))
Note: Dalam rumus ini, A2: A6 adalah daftar sel yang ingin Anda daftarkan kombinasinya, C2 adalah sel berisi rumus yang Anda buat di langkah 1.

3. Kemudian, salin dan tempel rumus berikut di sel D2, dan tekan Ctrl + Shift + Enter kunci bersama untuk mendapatkan hasil pertama, lihat tangkapan layar:

=IF(ROW()>2^(COUNTA(A$2:A$6)),"",TEXTJOIN(" + ",TRUE,IF(MID(TEXT(DEC2BIN(ROW()-1),REPT("0",COUNTA($A$2:$A$6))),ROW(INDIRECT("1:"&COUNTA($A$2:$A$6))),1)+0,TRIM(MID($C$3,(ROW(INDIRECT("1:"&COUNTA($A$2:$A$6)))-1)*$C$2+1,$C$2)),"")))
Note: Dalam rumus ini, A2: A6 adalah daftar sel yang ingin Anda daftarkan kombinasinya, C2 adalah sel berisi rumus yang Anda buat di langkah 1, C3 adalah sel dengan rumus yang Anda buat di langkah 2, the + karakter adalah pemisah untuk memisahkan kombinasi, Anda dapat mengubahnya sesuai kebutuhan.

4. Dan kemudian, pilih sel rumus ini, dan seret gagang isian ke bawah hingga sel kosong muncul. Sekarang, Anda dapat melihat semua kombinasi data kolom yang ditentukan ditampilkan seperti demo di bawah ini:

Note: Rumus ini hanya tersedia di Office 2019, 365 dan versi yang lebih baru.

Daftar semua kemungkinan kombinasi dari satu kolom dengan kode VBA

Rumus di atas hanya tersedia untuk versi Excel yang lebih baru, jika Anda memiliki versi Excel yang lebih lama, kode VBA berikut dapat membantu Anda.

1. tekan Alt + F11 tombol secara bersamaan untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Lalu klik Menyisipkan > Modul, salin dan tempel kode VBA di bawah ini ke jendela.

Kode VBA: Daftar semua kemungkinan kombinasi dari satu kolom

Sub ConnectArr()
'Updateby ExtendOffice
Dim xDValue As Variant
Dim xOutRg As Range
Dim xDictionary As Object
Dim xF As Long
Dim xChar As String
xDValue = Range("A2:A6").Value 'the data range
Set xOutRg = Range("C1") 'output range
xChar = "," 'separator
For xF = 1 To UBound(xDValue)
    Set xDictionary = CreateObject("Scripting.Dictionary")
    xDictionary(0) = "Sets of " & xF
    Call ConnectValue(xDValue, xDictionary, 0, xF, 0, "", xChar)
    xOutRg.Offset(0, xF - 1).Resize(xDictionary.Count).Value = WorksheetFunction.Transpose(xDictionary.Items)
    Set xDictionary = Nothing
Next
End Sub
Sub ConnectValue(ByRef pDValue, ByRef pDictionary, ByRef pLevel, ByVal pMaxLevel, ByVal pIndex, ByVal pValue, ByVal pChar)
Dim xF As Long
If pLevel = pMaxLevel Then
    pDictionary(pDictionary.Count + 1) = pValue
    Exit Sub
End If
For xF = pIndex + 1 To UBound(pDValue)
    If pValue = "" Then
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pDValue(xF, 1), pChar)
    Else
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pValue & pChar & pDValue(xF, 1), pChar)
    End If
Next
End Sub
Note: Pada kode diatas:
  • A2: A6: adalah daftar data yang ingin Anda gunakan;
  • C1: adalah sel keluaran;
  • ,: pembatas untuk memisahkan kombinasi.

3. Dan kemudian, tekan F5 kunci untuk mengeksekusi kode ini. Semua kombinasi dari satu kolom terdaftar seperti gambar di bawah ini:

Alat Produktivitas Kantor Terbaik

馃 Kutools AI Ajudan: Merevolusi analisis data berdasarkan: Eksekusi Cerdas   |  Hasilkan Kode  |  Buat Rumus Khusus  |  Analisis Data dan Hasilkan Grafik  |  Aktifkan Fungsi Kutools...
Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria  |   VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar   |  Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel   |  Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas:  12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

Deskripsi Produk

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
Comments (11)
No ratings yet. Be the first to rate!
S Shekhar
S Shekhar
This comment was minimized by the moderator on the site
Hi Skyyang,

Not sure if you are still active on this thread. But just taking a chance in case. I am not very familiar with VBA coding and am stuck in a situation where I need code to tackle one situation in my project. I need to create a unique combination from the list of variables mentioned in "SHEET1" cells "A2:A20". The combination will be of 2 variables listed in the row starting from A2 in SHEET2. And a list with 3 variable combinations listed in the row starting from A2 in SHEET3.

Thanks in advance.
Reply
0
0
iulker
iulker
This comment was minimized by the moderator on the site
Hello,
Nice job!
But I'm interested to find just the "Sets of 2", as in your example, e.g. a list of players who have to play matches with each other :).
Thank you.
Reply
Report
0
0
skyyang
skyyang     iulker
This comment was minimized by the moderator on the site
Hello, Iulian,
To solve your problem, please apply the below code:
Note: your names should be start at A2 cell, and the result will be placed at C2 cell.
Sub name_by_name()
    Dim i As Long, j As Long, lr As Long
    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr
            For j = i + 1 To lr
                .Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = _
                  .Cells(i, 1).Value & ", " & .Cells(j, 1).Value
            Next j
        Next i
    End With
End Sub


Please have a try, hope it can help you!

https://www.extendoffice.com/images/stories/comments/comment-skyyang/2023-comment/combinations-1.png
Reply
Report
0
0
Lynn
Lynn
This comment was minimized by the moderator on the site
Hello, I have a list of 30 items in a column and the code doesn't seem to be able to handle that, what is the max number of items allowed for the code to work? is there a way to make a long list work?
Reply
0
0
skyyang
skyyang     Lynn
This comment was minimized by the moderator on the site
Hello, Lynn,
Yes, as you said, if the number of cells are greater than 20, the code will not work well.
Sorry for that inconvenience.

With this code, it will pop out an alert if the number of cells is greater than 20.
Sub ConnectArr()
'Updateby ExtendOffice
Dim xDValue As Variant
Dim xOutRg As Range
Dim xDictionary As Object
Dim xF As Long
Dim xChar As String
Dim xAddress As String
xAddress = "A1:A20" 'the data range
If Range(xAddress).Count > 20 Then
    MsgBox "The number of cells can't greater than 20!"
    Exit Sub
End If
xDValue = Range(xAddress).Value
Set xOutRg = Range("C1") 'output range
xChar = "," 'separator
For xF = 1 To UBound(xDValue)
    Set xDictionary = CreateObject("Scripting.Dictionary")
    xDictionary(0) = "Sets of " & xF
    Call ConnectValue(xDValue, xDictionary, 0, xF, 0, "", xChar)
    xOutRg.Offset(0, xF - 1).Resize(xDictionary.Count).Value = WorksheetFunction.Transpose(xDictionary.Items)
    Set xDictionary = Nothing
Next
End Sub
Sub ConnectValue(ByRef pDValue, ByRef pDictionary, ByRef pLevel, ByVal pMaxLevel, ByVal pIndex, ByVal pValue, ByVal pChar)
Dim xF As Long
If pLevel = pMaxLevel Then
    pDictionary(pDictionary.Count + 1) = pValue
    Exit Sub
End If
For xF = pIndex + 1 To UBound(pDValue)
    If pValue = "" Then
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pDValue(xF, 1), pChar)
    Else
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pValue & pChar & pDValue(xF, 1), pChar)
    End If
Next
End Sub
Reply
Report
0
0
ffuuzz
ffuuzz
This comment was minimized by the moderator on the site
I really like the method but values bottom out at the 511th row and you get #NUM! if you have more than 6 entries in column A. I'm wondering if someone might consider helping me to adjust the formula so that the resulting values calculate beyond the 511th row? Thank you very much! =)
Reply
0
0
skyyang
skyyang     ffuuzz
This comment was minimized by the moderator on the site
Hello,
Yes, as you said, the formula will stop work in row 511. So, here, you can appy the VBA code in this article.
Or if you want to list all possible combinations into single one column, please apply the below code:
Note: In the code, A2 is the first cell contains the data you want to use, you should change the cell reference A2 and A to your own. After running the code, all combinations will be listed in the next column of the data list.
Sub allcombination()
Dim Ray As Variant, n As Long, nn As Long, Allnum As String, c As Long
Dim Res As Long, obit, oSt, ipc, Tot As Long, oPst As Long, sNum As String
Ray = Application.Transpose(Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)))
sNum = Join(Evaluate("TRANSPOSE(ROW(" & 1 & ":" & UBound(Ray) & "))"), ",")
For n = 1 To UBound(Ray)
    Tot = Tot + Application.Combin(UBound(Ray), n)
Next n
ReDim Oval(1 To Tot)
ReDim nRay(1 To Tot - UBound(Ray))
Do Until Allnum = sNum
   If c < UBound(Ray) Then
       For n = 1 To UBound(Ray)
             c = c + 1: Oval(c) = n
       Next n
   Else
       For n = 1 To UBound(Ray)
             Res = Res + 1
             obit = Oval(Res)
             oSt = Split(obit, ",")(UBound(Split(obit, ",")))
                For nn = oSt + 1 To UBound(Ray)
                    c = c + 1
                    Allnum = obit & "," & nn
                    Oval(c) = Allnum
                Next nn
         Next n
   End If
Loop
Dim s As Variant, nStr As String
    For oPst = UBound(Ray) + 1 To UBound(Oval)
        For Each s In Split(Oval(oPst), ",")
            nStr = nStr & IIf(nStr = "", Ray(s), "," & Ray(s))
        Next s
            nRay(oPst - UBound(Ray)) = nStr: nStr = ""
  Next oPst
Range("B1").Resize(UBound(nRay)).Value = Application.Transpose(nRay)
End Sub

Please have a try, hope it can help you! 馃檪
Reply
Report
0
0
ffuuzz
ffuuzz     skyyang
This comment was minimized by the moderator on the site
Dear skyyang:

Thank you very much for your help and the code. It's invaluable and I'm grateful.

I'm relatively new to VB scripting, consequently not very adept at coding the language.

Just a point or two:

- Your suggested code doesn't generate single entries (e.g. Ruby, or...)
- The original ordering as highlighted in the animated graphic in Step 4 disappeared.

I will go through your code to try my hand at calibrating it so that the above points are outputted, but I was wondering if you had any quick advice or suggestion(s) that could address them.

Thank you again for your kind help. I really appreciate it. =)

My best.
Reply
Report
0
0
ffuuzz
ffuuzz     skyyang
This comment was minimized by the moderator on the site
Dear skyyang:

First, thank you very much for your code solution. I am grateful! =)

I wrote a reply yesterday but the system seems not to have posted it for unknown reasons. I hope this one gets through.

Your code generates output that I am interested in. I had just a couple of observations and then a question:

1) The code doesn't generate the individual entries alone.
2) The original ordering seen in the animated graphic in Step 4 is lost.

From your code is there a way to also include the single entries and to mirror the original ordering format from Step 4. I'm rather new to VB scripting.

Again, thank you so much for your invaluable help. I really appreciate it.

My best.
Reply
0
0
ffuuzz
ffuuzz     skyyang
This comment was minimized by the moderator on the site
Dear skyyang:

This is wonderful. Thank you, this helps me out immensely. I am very grateful.

Just a couple observations I noticed after generating the VB code you provided was that the singletons (for lack of a better term), like just "Ruby", would get omitted, and the resulting (columnal) ordering no longer corresponded to the original ordering generated in Step 4 animated graphic.

Do you happen to have any quick suggestions about how I could tweak your code to also include the "singletons" and for matching the same ordering as in Step 4? I will try to wrangle the workaround but regrettably I'm fairly new to VB scripting.

Thanks again! I really appreciate it.

My best. =)
Reply
0
0
skyyang
skyyang     ffuuzz
This comment was minimized by the moderator on the site
Hello, ffuuzz
In this case, you can try the vba code in our article, all possible combinations will be listed into separated columns, please try:
Sub ConnectArr()
'Updateby ExtendOffice
Dim xDValue As Variant
Dim xOutRg As Range
Dim xDictionary As Object
Dim xF As Long
Dim xChar As String
xDValue = Range("A2:A6").Value 'the data range
Set xOutRg = Range("C1") 'output range
xChar = "," 'separator
For xF = 1 To UBound(xDValue)
    Set xDictionary = CreateObject("Scripting.Dictionary")
    xDictionary(0) = "Sets of " & xF
    Call ConnectValue(xDValue, xDictionary, 0, xF, 0, "", xChar)
    xOutRg.Offset(0, xF - 1).Resize(xDictionary.Count).Value = WorksheetFunction.Transpose(xDictionary.Items)
    Set xDictionary = Nothing
Next
End Sub
Sub ConnectValue(ByRef pDValue, ByRef pDictionary, ByRef pLevel, ByVal pMaxLevel, ByVal pIndex, ByVal pValue, ByVal pChar)
Dim xF As Long
If pLevel = pMaxLevel Then
    pDictionary(pDictionary.Count + 1) = pValue
    Exit Sub
End If
For xF = pIndex + 1 To UBound(pDValue)
    If pValue = "" Then
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pDValue(xF, 1), pChar)
    Else
        Call ConnectValue(pDValue, pDictionary, pLevel + 1, pMaxLevel, xF, pValue & pChar & pDValue(xF, 1), pChar)
    End If
Next
End Sub
Reply
Report
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
脳
Rate this post:
Reset
0   Characters
Suggested Locations