Подсчет количества одинаковых значений, вывод на другой лист

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Подсчет количества одинаковых значений, вывод на другой лист (Макросы/Sub)

Dorimar

Дата: Среда, 22.11.2017, 13:27 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

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

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

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

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

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

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

Сообщение отредактировал Dorimar - Среда, 22.11.2017, 14:47

Ответить

_Boroda_

Дата: Среда, 22.11.2017, 13:38 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

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

Код

=СЧЁТЕСЛИ(Лист1!B:B;B2)

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

К сообщению приложен файл: 5699082_1.xlsx (12.2 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Dorimar

Дата: Среда, 22.11.2017, 14:47 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Цитата _Boroda_, 22.11.2017 в 13:38, в сообщении № 2 ()

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

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

Ответить

_Igor_61

Дата: Четверг, 23.11.2017, 07:40 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 504

Репутация: 90 ±

Замечаний: 0% ±

Excel 2007

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

Сообщение отредактировал _Igor_61 - Четверг, 23.11.2017, 07:43

Ответить

_Igor_61

Дата: Четверг, 23.11.2017, 12:01 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 504

Репутация: 90 ±

Замечаний: 0% ±

Excel 2007

Проверяйте:

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

Ответить

and_evg

Дата: Четверг, 23.11.2017, 15:53 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 464

Репутация: 79 ±

Замечаний: 0% ±

Excel 2007

Вариант сводной

К сообщению приложен файл: 4625744.xlsx (14.2 Kb)

Ответить

Dorimar

Дата: Пятница, 24.11.2017, 14:39 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Спасибо!

Ответить

ВладимирG

Дата: Пятница, 24.11.2017, 17:09 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 136

Репутация: 22 ±

Замечаний: 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]

Ответить

_Igor_61

Дата: Суббота, 25.11.2017, 13:18 | Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 504

Репутация: 90 ±

Замечаний: 0% ±

Excel 2007

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

Ответить

RAN

Дата: Суббота, 25.11.2017, 16:28 | Сообщение № 10

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Раз пошла такая пьянка, реж последний огурец!

[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]

Быть или не быть, вот в чем загвоздка!

Ответить

nilem

Дата: Суббота, 25.11.2017, 21:20 | Сообщение № 11

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

на посошок )
[vba]

Код

Sheets(2).[B2:C2].Resize(.Count) = Application.Transpose(Array(.keys, .items))
' Sheets(2).[B2].Offset(, 1).Resize(.Count) = Application.Transpose(.items)

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Подсчет количества одинаковых значений, вывод на другой лист (Макросы/Sub)

Страница 1 из 1
1