Помогите пожалуйста допилить(если возможно)код уникальных значений.Перелопатил весь инет,вот самый оптимальный,но на 1 столбец.Описание внутри файла
Помогите пожалуйста допилить(если возможно)код уникальных значений.Перелопатил весь инет,вот самый оптимальный,но на 1 столбец.Описание внутри файлаgge29
а я бы на словарях делал сортировку не писал - только выборку уникальных
Sub dict() Dim d, r, brr() Set d = CreateObject("Scripting.Dictionary") Set r = Range([A1], [B34])
arr = r.Value For i = LBound(arr) ToUBound(arr)
a = r(i, 1)
b = r(i, 2)
k = a & "|" & b IfNot d.exists(k) Then d.Add k, Array(a, b) Next
n = d.Count ReDim brr(1To n, 1To2) For i = 1To n
c = d.Items()(i - 1)
brr(i, 1) = c(0)
brr(i, 2) = c(1) Next i
Sheets("ВЫБОР").[A1].Resize(n, 2) = brr EndSub
а я бы на словарях делал сортировку не писал - только выборку уникальных
Sub dict() Dim d, r, brr() Set d = CreateObject("Scripting.Dictionary") Set r = Range([A1], [B34])
arr = r.Value For i = LBound(arr) ToUBound(arr)
a = r(i, 1)
b = r(i, 2)
k = a & "|" & b IfNot d.exists(k) Then d.Add k, Array(a, b) Next
n = d.Count ReDim brr(1To n, 1To2) For i = 1To n
c = d.Items()(i - 1)
brr(i, 1) = c(0)
brr(i, 2) = c(1) Next i
Sheets("ВЫБОР").[A1].Resize(n, 2) = brr EndSub