Все УНИКАЛЬНЫЕ ПЕРЕВОДЫ

-6

Я нахожу множество алгоритмов, чтобы получить каждую перестановку цифр в наборе чисел. То, что я не могу найти, - это тот, который дает УНИКАЛЬНЫЙ список таких перестановок.

Например, цифры 123 будут выдавать:

123
132
213
231
312
321

Но цифры 113 должны выдавать (пропускать дубликаты):

113
131
311

Если это поможет, я буду использовать 8 цифр в массиве.

Спасибо

спросил(а) 2018-01-03T06:03:00+03:00 3 года, 3 месяца назад
0
87

Введите данные из ячейки a2 вниз и запустите макрос.

Sub UniqueNumber()
Dim vDB, vR(), a
Dim i As Integer, j As Integer, n As Long, z As Integer
Dim k As Integer, p As Integer
Dim dic As Object
Dim s As String

Set dic = CreateObject("Scripting.Dictionary")
vDB = Range("a2", Range("a" & Rows.Count).End(3))
z = UBound(vDB, 1)
ReDim Preserve vR(1 To 3)
For i = 1 To z: For j = 1 To z: For k = 1 To z

If i <> j And i <> k And j <> k Then
vR(1) = vDB(i, 1)
vR(2) = vDB(j, 1)
vR(3) = vDB(k, 1)
s = Join(vR, "")
If dic.Exists(s) Then
Else
n = n + 1
dic.Add s, s
End If
End If
Next k: Next j: Next i
a = dic.Keys
Range("d2").CurrentRegion.Offset(1).Clear
Range("d2").Resize(n) = WorksheetFunction.Transpose(a)
End Sub

enter image description here

ответил(а) 2018-01-03T07:27:00+03:00 3 года, 3 месяца назад
Ваш ответ
Введите минимум 50 символов
Чтобы , пожалуйста,
Выберите тему жалобы:

Другая проблема