Страницы: 1
RSS
Подсчет количества уникальных значений и вывод данных на другой лист
 
Добрый день!
Прошу помочь в решении задачи. Извиняюсь за название темы - не знал как точно описать)

Помогите пожалуйста, написать код (сразу оговорюсь, без формул, т.к. код будет вставлен в один большой макрос),
который посчитает количество каждого признака по БЕ, и выведет это количество на другой лист
Пример во вложении

В файле на Листе1 есть данные - БЕ и Признак, на Листе2 как должно быть в итоге (БЕ уже будут заполнены)
 
Доброе время суток
Цитата
Jordan07 написал:
(БЕ уже будут заполнены)
А смысл? Вариант.
 
Jordan07, Если БЕ уже будут заполнены, то макрос Hugo  из ветки  https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=42085
почти без изменений.
Код
Sub tt()
   Dim a(), b(), t$, i&, x&, y&
   a = [a1].CurrentRegion.Value 'данные с листа в массив
   b = Sheets(2).[a1].CurrentRegion.Value
   With CreateObject("scripting.dictionary")    'словарь
       For i = 1 To UBound(a)
           t = a(i, 1) & "|" & a(i, 2)    'меньше работы
           .Item(t) = .Item(t) + 1    'заносим пары  и подсчитываем повторы
       Next
       For x = 2 To UBound(b, 2)
           For y = 2 To UBound(b, 1)
               t = b(y, 1) & "|" & b(1, x)    'меньше работы
               If .exists(t) Then    'если есть в словаре
                   b(y, x) = .Item(t)    'извлекаем число повторов
               Else    'если нет
                   b(y, x) = 0    'ставим 0
               End If
           Next
       Next
   End With
   Sheets(2).[a1].CurrentRegion.Value = b 'данные из массива на лист!
End Sub
Изменено: casag - 16.07.2019 20:09:47
 
Андрей, спасибо за вариант, но мне он не очень подходит

casag, спасибо, проглядел эту тему. Но я в массивах пока не очень разбираюсь, и к сожалению не смог переделать под реальную задачу

Прошу помочь это сделать. В примере 2, мои реальные таблицы, оставил только необходимые данные
Лист "Получено". По каждой БЕ, нужно подсчитать количество признаков: Ввод, Модернизация или Корректировка (не путать с Корректировка NIOSS - это не нужно считать)
И данное количество, нужно перенести на лист "ЧЛ", в соответствующие столбцы, также по каждой БЕ

Буду признателен за помощь!
 
Цитата
Jordan07 написал:
в массивах пока не очень разбираюсь
Тогда, может быть, вас устроит вариант попроще и попонятней
Код
Sub csg()
Dim lr As Long
Sheets(2).Activate
lr = Cells(Rows.Count, "G").End(xlUp).Row
 With Range(Cells(2, 17), Cells(lr, 17))
    .Formula = "=COUNTIFS(Получено!C33,R1C17,Получено!C34,RC[-10])"
    .Calculate
    .Value = .Value
  End With
  With Range(Cells(2, 18), Cells(lr, 18))
     .Formula = "=COUNTIFS(Получено!C33,R1C18,Получено!C34,RC[-11])"
     .Calculate
     .Value = .Value
  End With
  With Range(Cells(2, 19), Cells(lr, 19))
     .Formula = "=COUNTIFS(Получено!C33,R1C19,Получено!C34,RC[-12])"
     .Calculate
     .Value = .Value
   End With
End Sub
 
Все вышло здорово, но хотелось бы без формул обойтись)
И я дико извиняюсь, забыл очень важную деталь( есть еще один столбец с данными - Задача
Считать нужно, так скажем, по сцепке БЕ+Задача+Признак

Т.е. в предыдущем примере, по таблице получилось количество 8, т.е. фактически количество строк
А, если по сцепке, то количество получилось бы 2 - вот именно его и нужно выводить на другой лист
ЗадачаПризнак:   ввод/модернизацияБЕ
23334
Значение1Ввод0010700
Значение1Ввод0010700
Значение1Ввод0010700
Значение1Ввод0010700
Значение2Ввод0010700
Значение2Ввод0010700
Значение2Ввод0010700
Значение2Ввод0010700
Еще раз прошу прощения, что не до конца изложил мысль(
Можно такой вариант осуществить, но без формул, а через массив?
 
Jordan07, А чем вас не устраивают формулы? Макрос вставляет формулы в нужный диапазон и после пересчета, оставляет в ячейках только значения. Зато вы всегда можете самостоятельно легко заменить или переделать формулу.
А за макрос через массив, я извините не возьмусь.Может кто поопытней поможет.
 
Я пытаюсь сам изучать VBA, посредством написания кода, сейчас есть отличная возможность по изучать массив) поэтому хотел без формул
Если предложите вариант с формулой по примеру 3, то буду очень рад все равно, т.к. других вариантов пока нет
Изменено: Jordan07 - 17.07.2019 15:27:51
 
Цитата
Jordan07 написал:
Т.е. в предыдущем примере, по таблице получилось количество 8, т.е. фактически количество строкА, если по сцепке, то количество получилось бы 2
Не понял, почему 2, вроде 4. И по какому "признаку" вам нужно выводить данные. Например в ячейку Q2 выводим количество "Признак1-Ввод-0010700".А куда выводить
"Признак2-Ввод-0010700" . Или вам нужен один, конкретный "Признак" из 16 . Тогда какой именно. Или я не так понял? Заполните вручную столбец Q цифрами, какие там должны появиться после работы макроса.
Изменено: casag - 17.07.2019 23:47:50
 
Признак - это название столбца)
Прошу прощения, что занял Ваше время, и спасибо за то, что уделили мне его. Возможно я не смог правильно передать свою мысль
Но решение было найдено)
Вот код и во вложении файл,если интересно посмотреть наглядно)
Код
Sub Primer()

Dim ЧЛ As Worksheet
Dim Получено As Worksheet
Set ЧЛ = Worksheets("Чек-лист")
Set Получено = Worksheets("Получено")

FinalRow3 = Получено.Cells(Rows.Count, 1).End(xlUp).Row
FinalRow5 = ЧЛ.Cells(Rows.Count, 7).End(xlUp).Row

Dim dicСцепка As New Dictionary

For k = 4 To FinalRow3
    БЕ = CStr(Получено.Cells(k, 34))
    Задача = CStr(Получено.Cells(k, 2))
    Признак = CStr(Получено.Cells(k, 33))
    
        If dicСцепка.Exists(Признак & "_" & БЕ & "_" & Задача) = False Then dicСцепка.Add Признак & "_" & БЕ & "_" & Задача, Признак & "_" & БЕ & "_" & Задача
Next k

For y = 2 To FinalRow5
    For x = 17 To 19
        dsd = 0
            For Each varItem In Filter(dicСцепка.Items, ЧЛ.Cells(1, x).Value & "_" & ЧЛ.Cells(y, 7).Value)
                dsd = dsd + 1
            Next
        ЧЛ.Cells(y, x) = dsd
    Next x
Next y
End Sub
Изменено: Jordan07 - 18.07.2019 17:47:10
 
Цитата
Jordan07 написал:
код как-то не правильно вставляется через тэг - в одну строку
Обновите страницу (F5) и всё чудесным образом отремонтируется ))
 
Цитата
Юрий М написал:
Обновите страницу (F5)
Спасибо)
Страницы: 1
Наверх