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

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выборка и подсчет уникальных значений - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборка и подсчет уникальных значений (Макросы/Sub)
Выборка и подсчет уникальных значений
Raid Дата: Среда, 28.08.2019, 22:34 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 365
Уважаемые знатоки, пользовался гуглом, поиском по форуму - однозначный ответ на свой вопрос не нашел.
Задача следующая - есть массив фамилий повоторяющихся, нужно вывести частоту встречаемости каждой на отдельный лист.
Т.е. что бы это выглядело следующим образом:
Шацкая - 8
Артеменко - 5
Клименко - 10
......
......

Есть куча схожих вариантов, но я не смог приспособить под свою таблицу, скорее всего, вследствие недостаточности знаний работы с массивами
Пример файла ниже
К сообщению приложен файл: 8341266.xlsm(66.0 Kb)
 
Ответить
СообщениеУважаемые знатоки, пользовался гуглом, поиском по форуму - однозначный ответ на свой вопрос не нашел.
Задача следующая - есть массив фамилий повоторяющихся, нужно вывести частоту встречаемости каждой на отдельный лист.
Т.е. что бы это выглядело следующим образом:
Шацкая - 8
Артеменко - 5
Клименко - 10
......
......

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

Автор - Raid
Дата добавления - 28.08.2019 в 22:34
gling Дата: Среда, 28.08.2019, 23:04 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1968
Репутация: 488 ±
Замечаний: 0% ±

2010
Здравствуйте.
Задача следующая
Если правильно понял, то задача1 - из массива с фамилиями составить список всех фамилий. Задача 2 - против каждой фамилии прописать сколько раз эта фамилия встречается в массиве. Или уж есть список фамилий которые нужно посчитать? На соседнем листе я его не увидел. Пр наличии списка посчитать можно просто
Код
=СЧЁТЕСЛИ(График!$A$1:$AD$14;A1)
Сложнее из массива выбрать все фамилии и составить список.


ЯД-41001506838083
 
Ответить
СообщениеЗдравствуйте.
Задача следующая
Если правильно понял, то задача1 - из массива с фамилиями составить список всех фамилий. Задача 2 - против каждой фамилии прописать сколько раз эта фамилия встречается в массиве. Или уж есть список фамилий которые нужно посчитать? На соседнем листе я его не увидел. Пр наличии списка посчитать можно просто
Код
=СЧЁТЕСЛИ(График!$A$1:$AD$14;A1)
Сложнее из массива выбрать все фамилии и составить список.

Автор - gling
Дата добавления - 28.08.2019 в 23:04
Raid Дата: Четверг, 29.08.2019, 08:01 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 365
Спасибо за ответ.
Списка уникальных фамилий нет...
И, из чувства к прекрастному, если это возможно решить задачу в VBA
 
Ответить
СообщениеСпасибо за ответ.
Списка уникальных фамилий нет...
И, из чувства к прекрастному, если это возможно решить задачу в VBA

Автор - Raid
Дата добавления - 29.08.2019 в 08:01
Pelena Дата: Четверг, 29.08.2019, 19:11 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 14474
Репутация: 3172 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
[vba]
Код
Sub CountUniqueValues()
    Dim oDic As Object, rng As Range
    Set oDic = CreateObject("Scripting.Dictionary")
    For Each rng In Sheets("График").Range("A1").CurrentRegion
        If rng.Value <> "" Then
            If oDic.Exists(rng.Value) Then
                oDic(rng.Value) = oDic(rng.Value) + 1
            Else
                oDic(rng.Value) = 1
            End If
        End If
    Next rng
    With Sheets("Статистика")
        .UsedRange.ClearContents
        .Range("A1").Resize(oDic.Count) = Application.Transpose(oDic.Keys)
        .Range("B1").Resize(oDic.Count) = Application.Transpose(oDic.Items)
    End With
End Sub
[/vba]
К сообщению приложен файл: 4977295.xlsm(70.4 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение[vba]
Код
Sub CountUniqueValues()
    Dim oDic As Object, rng As Range
    Set oDic = CreateObject("Scripting.Dictionary")
    For Each rng In Sheets("График").Range("A1").CurrentRegion
        If rng.Value <> "" Then
            If oDic.Exists(rng.Value) Then
                oDic(rng.Value) = oDic(rng.Value) + 1
            Else
                oDic(rng.Value) = 1
            End If
        End If
    Next rng
    With Sheets("Статистика")
        .UsedRange.ClearContents
        .Range("A1").Resize(oDic.Count) = Application.Transpose(oDic.Keys)
        .Range("B1").Resize(oDic.Count) = Application.Transpose(oDic.Items)
    End With
End Sub
[/vba]

Автор - Pelena
Дата добавления - 29.08.2019 в 19:11
Raid Дата: Четверг, 29.08.2019, 20:32 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 365
Pelena, спасибо огромное, очень красиво, и функционально !!!
Очень, очень спасибо!
 
Ответить
СообщениеPelena, спасибо огромное, очень красиво, и функционально !!!
Очень, очень спасибо!

Автор - Raid
Дата добавления - 29.08.2019 в 20:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборка и подсчет уникальных значений (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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