Версия для слабовидящих
Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

 

= Мир MS Excel/Уникальное значение по 2 условиям - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Уникальное значение по 2 условиям
gge29 Дата: Пятница, 19.08.2022, 21:07 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 303
Репутация: 3 ±
Замечаний: 0% ±

Помогите пожалуйста допилить(если возможно)код уникальных значений.Перелопатил весь инет,вот самый оптимальный,но на 1 столбец.Описание внутри файла
К сообщению приложен файл: Unique.xls (39.5 Kb)
 
Ответить
СообщениеПомогите пожалуйста допилить(если возможно)код уникальных значений.Перелопатил весь инет,вот самый оптимальный,но на 1 столбец.Описание внутри файла

Автор - gge29
Дата добавления - 19.08.2022 в 21:07
прохожий2019 Дата: Пятница, 19.08.2022, 23:52 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1395
Репутация: 364 ±
Замечаний: 0% ±

365 Beta Channel
Цитата gge29, 19.08.2022 в 21:07, в сообщении № 1 ( писал(а)):
вот самый оптимальный
а я бы на словарях делал
сортировку не писал - только выборку уникальных

Sub dict()
    Dim d, r, brr()
    Set d = CreateObject("Scripting.Dictionary")
    Set r = Range([A1], [B34])
    arr = r.Value
    For i = LBound(arr) To UBound(arr)
        a = r(i, 1)
        b = r(i, 2)
        k = a & "|" & b
        If Not d.exists(k) Then d.Add k, Array(a, b)
    Next
    n = d.Count
    ReDim brr(1 To n, 1 To 2)
    For i = 1 To n
        c = d.Items()(i - 1)
        brr(i, 1) = c(0)
        brr(i, 2) = c(1)
    Next i
    Sheets("ВЫБОР").[A1].Resize(n, 2) = brr
End Sub

К сообщению приложен файл: Unique.xlsm (21.8 Kb)


Сообщение отредактировал прохожий2019 - Пятница, 19.08.2022, 23:54
 
Ответить
Сообщение
Цитата gge29, 19.08.2022 в 21:07, в сообщении № 1 ( писал(а)):
вот самый оптимальный
а я бы на словарях делал
сортировку не писал - только выборку уникальных
[vba]
Sub dict()    Dim d, r, brr()    Set d = CreateObject("Scripting.Dictionary")    Set r = Range([A1], [B34])    arr = r.Value    For i = LBound(arr) To UBound(arr)        a = r(i, 1)        b = r(i, 2)        k = a & "|" & b        If Not d.exists(k) Then d.Add k, Array(a, b)    Next    n = d.Count    ReDim brr(1 To n, 1 To 2)    For i = 1 To n        c = d.Items()(i - 1)        brr(i, 1) = c(0)        brr(i, 2) = c(1)    Next i    Sheets("ВЫБОР").[A1].Resize(n, 2) = brrEnd Sub
[/vba]

Автор - прохожий2019
Дата добавления - 19.08.2022 в 23:52
gge29 Дата: Суббота, 20.08.2022, 21:13 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 303
Репутация: 3 ±
Замечаний: 0% ±

Спасибо!Под основную допилил,подошло
 
Ответить
СообщениеСпасибо!Под основную допилил,подошло

Автор - gge29
Дата добавления - 20.08.2022 в 21:13
  • Страница 1 из 1
  • 1
Поиск:

Рейтинг@Mail.ru Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!