Salt la conținutul principal

Cum să enumerați toate combinațiile posibile dintr-o singură coloană în Excel?

Dacă doriți să returnați toate combinațiile posibile din datele dintr-o singură coloană pentru a obține rezultatul așa cum se arată în captura de ecran de mai jos, aveți vreo modalitate rapidă de a face față acestei sarcini în Excel?

Listați toate combinațiile posibile dintr-o singură coloană cu formule

Listați toate combinațiile posibile dintr-o singură coloană cu cod VBA


Listați toate combinațiile posibile dintr-o singură coloană cu formule

Următoarele formule matrice vă pot ajuta să realizați această sarcină, vă rugăm să faceți pas cu pas:

1. În primul rând, ar trebui să creați două celule de formulă de ajutor. În celula C1, introduceți formula de mai jos și apăsați Ctrl + Shift + Enter chei pentru a obține rezultatul:

=MAX(LEN(A2:A6))
notițe: În această formulă, A2: A6 este lista de celule pe care doriți să le listați combinațiile.

2. În celula C2, introduceți următoarea formulă și apăsați Ctrl + Shift + Enter tastele împreună pentru a obține al doilea rezultat, vedeți captura de ecran:

=CONCAT(A2:A6&REPT(" ",C2-LEN(A2:A6)))
notițe: În această formulă, A2: A6 este lista de celule pe care doriți să le listați combinațiile, C2 este celula conține formula pe care ați creat-o la pasul 1.

3. Apoi, copiați și lipiți următoarea formulă în celula D2 și apăsați Ctrl + Shift + Enter tastele împreună pentru a obține primul rezultat, vezi captura de ecran:

=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)),"")))
notițe: În această formulă, A2: A6 este lista de celule pe care doriți să le listați combinațiile, C2 celula conține formula pe care ați creat-o la pasul 1, C3 este celula cu formula pe care ați creat-o la pasul 2, the + caracterul este separatorul pentru a separa combinațiile, le puteți schimba după cum aveți nevoie.

4. Apoi, selectați această celulă de formulă și trageți mânerul de umplere în jos până când apar celule goale. Acum, puteți vedea că toate combinațiile de date ale coloanei specificate sunt afișate așa cum se arată mai jos:

notițe: Această formulă este disponibilă numai în Office 2019, 365 și versiunea ulterioară.

Listați toate combinațiile posibile dintr-o singură coloană cu cod VBA

Formulele de mai sus sunt disponibile numai pentru versiunile mai noi de Excel, dacă aveți versiuni anterioare de Excel, următorul cod VBA vă poate face o favoare.

1. presa Alt + F11 tastele simultan pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

2. Apoi apasa Insera > Module, copiați și inserați codul VBA de mai jos în fereastră.

Cod VBA: enumerați toate combinațiile posibile dintr-o singură coloană

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
notițe: În codul de mai sus:
  • A2: A6: este lista de date pe care doriți să le utilizați;
  • C1: este celula de ieșire;
  • ,: delimitatorul pentru a separa combinațiile.

3. Și apoi, apăsați F5 tasta pentru a executa acest cod. Toate combinațiile dintr-o singură coloană sunt listate după cum se arată mai jos:

Cele mai bune instrumente de productivitate de birou

🤖 Kutools AI Aide: Revoluționați analiza datelor pe baza: Execuție inteligentă   |  Generați codul  |  Creați formule personalizate  |  Analizați datele și generați diagrame  |  Invocați funcțiile Kutools...
Caracteristici populare: Găsiți, evidențiați sau identificați duplicatele   |  Ștergeți rândurile goale   |  Combinați coloane sau celule fără a pierde date   |   Rundă fără Formula ...
Super căutare: VLookup cu mai multe criterii    VLookup cu valori multiple  |   VLookup pe mai multe foi   |   Căutare fuzzy ....
Listă derulantă avansată: Creați rapid o listă derulantă   |  Listă drop-down dependentă   |  Listă derulantă cu selectare multiplă ....
Manager de coloane: Adăugați un număr specific de coloane  |  Mutați coloanele  |  Comutați starea vizibilității coloanelor ascunse  |  Comparați intervale și coloane ...
Caracteristici prezentate: Focus pe grilă   |  Vedere de proiectare   |   Big Formula Bar    Manager registru de lucru și foi   |  Biblioteca de resurse (Text automat)   |  Data Picker   |  Combinați foi de lucru   |  Criptare/Decriptare celule    Trimiteți e-mailuri după listă   |  Super Filtru   |   Filtru special (filtrează bold/italic/barat...) ...
Top 15 seturi de instrumente12 Text Instrumente (Adăuga text, Eliminați caractere,...)   |   50+ Diagramă Tipuri de (Gantt Chart,...)   |   40+ Practic Formule (Calculați vârsta pe baza zilei de naștere,...)   |   19 inserare Instrumente (Introduceți codul QR, Inserați imaginea din cale,...)   |   12 Convertire Instrumente (Numere la cuvinte, conversie valutara,...)   |   7 Merge & Split Instrumente (Rânduri combinate avansate, Celule divizate,...)   |   ... și altele

Îmbunătățiți-vă abilitățile Excel cu Kutools pentru Excel și experimentați eficiența ca niciodată. Kutools pentru Excel oferă peste 300 de funcții avansate pentru a crește productivitatea și a economisi timp.  Faceți clic aici pentru a obține funcția de care aveți cea mai mare nevoie...

Descriere


Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
Comments (11)
No ratings yet. Be the first to rate!
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.
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.
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
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?
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

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! =)
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! 🙂
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.
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.
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. =)
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
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations