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

Вход

Регистрация

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

 

= Мир MS Excel/Подсчет количества одинаковых значений, вывод на другой лист - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подсчет количества одинаковых значений, вывод на другой лист (Макросы/Sub)
Подсчет количества одинаковых значений, вывод на другой лист
Dorimar Дата: Среда, 22.11.2017, 13:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте! Есть 2 листа. На первом листе находится список документов, во втором столбце листа находятся коды запуска ракет категории этих документов - определенные цифровые значения, которые повторяются в зависимости от категории документа.

На втором листе находится список категорий этих документов. Код категории находится также во втором столбце.

Список довольно большой (89 категорий) и свыше 2х тысяч документов.

Подскажите макрос, который бы на втором листе вывел количество ячеек с этим кодом с первого листа напротив каждого из кодов.

Файл пример прилагаю.
К сообщению приложен файл: 5699082.xlsx(11Kb)


Сообщение отредактировал Dorimar - Среда, 22.11.2017, 14:47
 
Ответить
СообщениеЗдравствуйте! Есть 2 листа. На первом листе находится список документов, во втором столбце листа находятся коды запуска ракет категории этих документов - определенные цифровые значения, которые повторяются в зависимости от категории документа.

На втором листе находится список категорий этих документов. Код категории находится также во втором столбце.

Список довольно большой (89 категорий) и свыше 2х тысяч документов.

Подскажите макрос, который бы на втором листе вывел количество ячеек с этим кодом с первого листа напротив каждого из кодов.

Файл пример прилагаю.

Автор - Dorimar
Дата добавления - 22.11.2017 в 13:27
_Boroda_ Дата: Среда, 22.11.2017, 13:38 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11852
Репутация: 4911 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Обязательно макросом? 100х3000 тормозить не будет
Код
=СЧЁТЕСЛИ(Лист1!B:B;B2)


[p.s.]В названии темы не стоит ли "сумма" заменить на "количество"?
К сообщению приложен файл: 5699082_1.xlsx(12Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеОбязательно макросом? 100х3000 тормозить не будет
Код
=СЧЁТЕСЛИ(Лист1!B:B;B2)


[p.s.]В названии темы не стоит ли "сумма" заменить на "количество"?

Автор - _Boroda_
Дата добавления - 22.11.2017 в 13:38
Dorimar Дата: Среда, 22.11.2017, 14:47 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Обязательно макросом? 100х3000 тормозить не будет

Как вариант можно функцией, но постоянная зависимость от соседнего листа не так надежно. На сколько я понимаю, если я отделю второй лист на отдельный файл, то вместо данных получу ошибку? И да, вы правы, "количество" правильнее.
 
Ответить
Сообщение
Обязательно макросом? 100х3000 тормозить не будет

Как вариант можно функцией, но постоянная зависимость от соседнего листа не так надежно. На сколько я понимаю, если я отделю второй лист на отдельный файл, то вместо данных получу ошибку? И да, вы правы, "количество" правильнее.

Автор - Dorimar
Дата добавления - 22.11.2017 в 14:47
_Igor_61 Дата: Четверг, 23.11.2017, 07:40 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 238
Репутация: 44 ±
Замечаний: 20% ±

Excel 2007
Здравствуйте! Вариант макроса
Невнимательно посмотрел - нужно кол-во ячеек, а не значения


Сообщение отредактировал _Igor_61 - Четверг, 23.11.2017, 07:43
 
Ответить
СообщениеЗдравствуйте! Вариант макроса
Невнимательно посмотрел - нужно кол-во ячеек, а не значения

Автор - _Igor_61
Дата добавления - 23.11.2017 в 07:40
_Igor_61 Дата: Четверг, 23.11.2017, 12:01 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 238
Репутация: 44 ±
Замечаний: 20% ±

Excel 2007
Проверяйте:
К сообщению приложен файл: 5699082_1.xlsm(24Kb)
 
Ответить
СообщениеПроверяйте:

Автор - _Igor_61
Дата добавления - 23.11.2017 в 12:01
and_evg Дата: Четверг, 23.11.2017, 15:53 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 41 ±
Замечаний: 0% ±

Excel 2007
Вариант сводной
К сообщению приложен файл: 4625744.xlsx(14Kb)
 
Ответить
СообщениеВариант сводной

Автор - and_evg
Дата добавления - 23.11.2017 в 15:53
Dorimar Дата: Пятница, 24.11.2017, 14:39 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Спасибо!
 
Ответить
СообщениеСпасибо!

Автор - Dorimar
Дата добавления - 24.11.2017 в 14:39
ВладимирG Дата: Пятница, 24.11.2017, 17:09 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация: 21 ±
Замечаний: 0% ±

2007
[vba]
Код
Sub Perenos()
Dim kods As Range, i&, y&
Set kods = [B1].CurrentRegion.Offset(1)
ReDim t(1 To kods.Rows.Count, 1 To 2)
With CreateObject("Scripting.Dictionary")
For i = 1 To kods.Rows.Count
    .Item(kods(i, 1)) = i
    If kods(i + 1, 1) <> kods(i, 1) Then
        y = y + 1
        t(y, 1) = kods(i, 1)
        t(y, 2) = WorksheetFunction.CountIf(kods, kods(i, 1))
    End If
Next
Sheets(2).[B2].Resize(y, 2) = t
End With
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub Perenos()
Dim kods As Range, i&, y&
Set kods = [B1].CurrentRegion.Offset(1)
ReDim t(1 To kods.Rows.Count, 1 To 2)
With CreateObject("Scripting.Dictionary")
For i = 1 To kods.Rows.Count
    .Item(kods(i, 1)) = i
    If kods(i + 1, 1) <> kods(i, 1) Then
        y = y + 1
        t(y, 1) = kods(i, 1)
        t(y, 2) = WorksheetFunction.CountIf(kods, kods(i, 1))
    End If
Next
Sheets(2).[B2].Resize(y, 2) = t
End With
End Sub
[/vba]

Автор - ВладимирG
Дата добавления - 24.11.2017 в 17:09
_Igor_61 Дата: Суббота, 25.11.2017, 13:18 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 238
Репутация: 44 ±
Замечаний: 20% ±

Excel 2007
ВладимирG, классный код! Лаконично и эффективно, не то что у некоторых из 5-го сообщения :)
 
Ответить
СообщениеВладимирG, классный код! Лаконично и эффективно, не то что у некоторых из 5-го сообщения :)

Автор - _Igor_61
Дата добавления - 25.11.2017 в 13:18
RAN Дата: Суббота, 25.11.2017, 16:28 | Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4622
Репутация: 937 ±
Замечаний: 0% ±

2010
Раз пошла такая пьянка, реж последний огурец! :D
[vba]
Код
Sub Мяу()
    Dim ar, i&
    With Sheets(1).[B1].CurrentRegion
        ar = .Offset(1).Resize(.Rows.Count - 1).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            .Item(ar(i, 1)) = .Item(ar(i, 1)) + 1
        Next
        Sheets(2).[B2].Resize(.Count) = Application.Transpose(.keys)
        Sheets(2).[B2].Offset(, 1).Resize(.Count) = Application.Transpose(.items)
    End With
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеРаз пошла такая пьянка, реж последний огурец! :D
[vba]
Код
Sub Мяу()
    Dim ar, i&
    With Sheets(1).[B1].CurrentRegion
        ar = .Offset(1).Resize(.Rows.Count - 1).Value
    End With
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            .Item(ar(i, 1)) = .Item(ar(i, 1)) + 1
        Next
        Sheets(2).[B2].Resize(.Count) = Application.Transpose(.keys)
        Sheets(2).[B2].Offset(, 1).Resize(.Count) = Application.Transpose(.items)
    End With
End Sub
[/vba]

Автор - RAN
Дата добавления - 25.11.2017 в 16:28
nilem Дата: Суббота, 25.11.2017, 21:20 | Сообщение № 11
Группа: Авторы
Ранг: Старожил
Сообщений: 1343
Репутация: 477 ±
Замечаний: 0% ±

Excel 2013
на посошок )
[vba]
Код
Sheets(2).[B2:C2].Resize(.Count) = Application.Transpose(Array(.keys, .items))
' Sheets(2).[B2].Offset(, 1).Resize(.Count) = Application.Transpose(.items)
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениена посошок )
[vba]
Код
Sheets(2).[B2:C2].Resize(.Count) = Application.Transpose(Array(.keys, .items))
' Sheets(2).[B2].Offset(, 1).Resize(.Count) = Application.Transpose(.items)
[/vba]

Автор - nilem
Дата добавления - 25.11.2017 в 21:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подсчет количества одинаковых значений, вывод на другой лист (Макросы/Sub)
Страница 1 из 11
Поиск:

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