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

Вход

Регистрация

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

 

= Мир MS Excel/подсчет в массиве - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » подсчет в массиве (Макросы/Sub)
подсчет в массиве
mss Дата: Среда, 09.05.2018, 15:10 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Добрый день, помогите дописать макрос, сейчас в ячейках с F2 пи выполнении макроса "список" формируется уникальный список из двух позиций, но не могу в третий столбец вывести сколько раз данные комбинации встречались в исходном списке С2:D21. Сразу оговорюсь, что использование формулы countif не подойдет, надо считать количество по уникальному ключу в массиве и выводить в столбец H. Спасибо
К сообщению приложен файл: 3704751.xlsm (14.1 Kb)
 
Ответить
СообщениеДобрый день, помогите дописать макрос, сейчас в ячейках с F2 пи выполнении макроса "список" формируется уникальный список из двух позиций, но не могу в третий столбец вывести сколько раз данные комбинации встречались в исходном списке С2:D21. Сразу оговорюсь, что использование формулы countif не подойдет, надо считать количество по уникальному ключу в массиве и выводить в столбец H. Спасибо

Автор - mss
Дата добавления - 09.05.2018 в 15:10
_Boroda_ Дата: Среда, 09.05.2018, 15:29 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
На основе Вашего макроса, особо там не переделывая ничего, хоть и хотелось :D
[vba]
Код
Sub список()
Dim arr
    arr = Range("C2:D21")
    ReDim b(1 To UBound(arr), 1 To 2)
    With CreateObject("scripting.dictionary")
        .CompareMode = 1
        For i = 1 To UBound(arr)
            t = arr(i, 1) & "|" & arr(i, 2)
            If Len(t) > 1 Then
            If Not .exists(t) Then
                .Item(t) = 1
                ii = ii + 1
                b(ii, 1) = arr(i, 1)
                b(ii, 2) = arr(i, 2)
            Else
                .Item(t) = .Item(t) + 1
            End If
            End If
        Next
        If ii > 0 Then [f2].Resize(ii, 2) = b
        [f2].Offset(, 2).Resize(ii) = Application.Transpose(.Items)
   End With
End Sub
[/vba]

*И посмотрите свою предыдущую тему, там еще ответ есть
К сообщению приложен файл: 3704751_1.xlsm (14.8 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНа основе Вашего макроса, особо там не переделывая ничего, хоть и хотелось :D
[vba]
Код
Sub список()
Dim arr
    arr = Range("C2:D21")
    ReDim b(1 To UBound(arr), 1 To 2)
    With CreateObject("scripting.dictionary")
        .CompareMode = 1
        For i = 1 To UBound(arr)
            t = arr(i, 1) & "|" & arr(i, 2)
            If Len(t) > 1 Then
            If Not .exists(t) Then
                .Item(t) = 1
                ii = ii + 1
                b(ii, 1) = arr(i, 1)
                b(ii, 2) = arr(i, 2)
            Else
                .Item(t) = .Item(t) + 1
            End If
            End If
        Next
        If ii > 0 Then [f2].Resize(ii, 2) = b
        [f2].Offset(, 2).Resize(ii) = Application.Transpose(.Items)
   End With
End Sub
[/vba]

*И посмотрите свою предыдущую тему, там еще ответ есть

Автор - _Boroda_
Дата добавления - 09.05.2018 в 15:29
mss Дата: Среда, 09.05.2018, 15:38 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Спасибо, спасибо за прошлую тему я видел, просто от Pelena очень устроил вариант, а ваш я пытался запустить но он почему-то не сработал:(
 
Ответить
СообщениеСпасибо, спасибо за прошлую тему я видел, просто от Pelena очень устроил вариант, а ваш я пытался запустить но он почему-то не сработал:(

Автор - mss
Дата добавления - 09.05.2018 в 15:38
_Boroda_ Дата: Среда, 09.05.2018, 15:58 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
ваш я пытался запустить но он почему-то не сработал

Ну так нужно было об этом написать
Дописал там для 2007 Excel (сразу не заметил у Вас в профиле)

*В этой теме все нормально работает?


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

Ну так нужно было об этом написать
Дописал там для 2007 Excel (сразу не заметил у Вас в профиле)

*В этой теме все нормально работает?

Автор - _Boroda_
Дата добавления - 09.05.2018 в 15:58
Мир MS Excel » Вопросы и решения » Вопросы по VBA » подсчет в массиве (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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