Получение только уникальных комбинаций с данными из 1 столбца нескольких строк VBA - PullRequest
0 голосов
/ 12 июня 2018

Я знаю, как создать все возможные комбинации, но у меня возникают трудности с получением только уникальных комбинаций.

В моем примере у меня есть 5 строк значений данных (1,2,3,4,5) в A3:A7

Моя цель состоит в том, чтобы получить все уникальные комбинации с этими данными и не иметь повторяющихся.

Вот код, который у меня есть сейчас

Private Sub CommandButton1_Click()

For i = 3 To 7
Cells(i, 1) = i - 2
Next i

Cells(1, 3) = "number"
Cells(3, 3) = "combinations"

For i = 3 To 7
For Z = 3 To 6
last = Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(3, 1), Cells(7, 1)).Copy Destination:=Range(Cells(3, last + 1), Cells(7, last + 1))
temp = Cells(i, 1)
Cells(i, last + 1) = Cells(Z + 1, 1)
Cells(Z + 1, last + 1) = temp
Next Z
Next i

End Sub

Здесь можно увидеть, что происходит в файле Excel Excel representation

1 Ответ

0 голосов
/ 12 июня 2018

Если идея состоит в том, чтобы создать некоторый случайный диапазон и увидеть уникальные ячейки, это может быть несколько вариантов:

  1. Создать диапазон;
  2. Положить в него несколько случайных значений;
  3. Используйте встроенную формулу для WorksheetFunction.CountIf(), чтобы увидеть, является ли значение уникальным;
  4. Если оно уникально, раскрасьте его в пурпурный цвет:

enter image description here

Option Explicit

Public Sub GenerateRandoms()

    Dim someRange As Range
    Set someRange = Range("A1:F20")
    someRange.Clear

    Dim myCell As Range

    For Each myCell In someRange
        myCell = MakeRandom(1, 50)
    Next myCell

    Dim someUniqueValues As Range

    For Each myCell In someRange
        If WorksheetFunction.CountIf(someRange, myCell) = 1 Then
            myCell.Interior.Color = vbMagenta
        End If
    Next myCell

End Sub

Private Function MakeRandom(down As Long, up As Long) As Long
    MakeRandom = CLng((up - down) * Rnd + down)
End Function
...