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

Вход

Регистрация

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

 

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

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

Excel 2016
Коллеги, добрый вечер.
Очень нужна Ваша помощь.
В большом файле находится информация, сколько каждый сотрудник продает товара за день, и какую получает оценку.
Задача состоит в том, чтобы на лист 2 вывести информацию: напротив каждого сотрудника - сколько каждый сотрудник продал товара (в виде суммы товара) и какое количество оценок оценок он получил.
Моих мозгов хватает только чтобы посчитать просто кол-во товара сколько продал сотрудник.
Через формулу счет если считается оценка, но нюанс в том, что файл на выходе получается очень большой, и формула работает около часа, что очень долго(
Помогите пожалуйста в решении данной задачи.
К сообщению приложен файл: 123456.xlsm(21.3 Kb)
 
Ответить
СообщениеКоллеги, добрый вечер.
Очень нужна Ваша помощь.
В большом файле находится информация, сколько каждый сотрудник продает товара за день, и какую получает оценку.
Задача состоит в том, чтобы на лист 2 вывести информацию: напротив каждого сотрудника - сколько каждый сотрудник продал товара (в виде суммы товара) и какое количество оценок оценок он получил.
Моих мозгов хватает только чтобы посчитать просто кол-во товара сколько продал сотрудник.
Через формулу счет если считается оценка, но нюанс в том, что файл на выходе получается очень большой, и формула работает около часа, что очень долго(
Помогите пожалуйста в решении данной задачи.

Автор - Vladimir32
Дата добавления - 05.02.2019 в 22:21
Pelena Дата: Вторник, 05.02.2019, 22:47 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 14009
Репутация: 3065 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Здравствуйте.
Сводная не подойдет?
К сообщению приложен файл: 9024819.xlsm(26.9 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Сводная не подойдет?

Автор - Pelena
Дата добавления - 05.02.2019 в 22:47
Vladimir32 Дата: Среда, 06.02.2019, 07:58 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
К сожалению сводная не подходит, в дальнейшем таблица будет больше, и обновляется будет автоматически обновляется. Пытался делать с помощью массива, но он просто выводит по дате и ФИО просто данные с первого листа, как их посчитать мозгов не хватает. Думал добавить еще столбец с номером месяца, это тоже ничего не дало.
 
Ответить
СообщениеК сожалению сводная не подходит, в дальнейшем таблица будет больше, и обновляется будет автоматически обновляется. Пытался делать с помощью массива, но он просто выводит по дате и ФИО просто данные с первого листа, как их посчитать мозгов не хватает. Думал добавить еще столбец с номером месяца, это тоже ничего не дало.

Автор - Vladimir32
Дата добавления - 06.02.2019 в 07:58
_Boroda_ Дата: Среда, 06.02.2019, 09:51 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14954
Репутация: 5916 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Сводную всегда можно сделать по бОльшему диапазону (в примере сделано на все строки Excel)
Запускать макрос Вы все равно будете вручную, для того у Вас там кнопка и висит, так ведь? Ну вот и повесим на эту кнопку макрос обновления сводной

А если у Вас данных много, то сводная таблица - наилучший по скорости вариант
К сообщению приложен файл: 123456_1.xlsm(28.2 Kb)


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

А если у Вас данных много, то сводная таблица - наилучший по скорости вариант

Автор - _Boroda_
Дата добавления - 06.02.2019 в 09:51
Vladimir32 Дата: Среда, 06.02.2019, 10:21 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Что касается скорости вы совершенно правы, сводная наилучший вариант. Там проблема в том, что таблица имеет определенный формат (своеобразная консолидации). Кнопку туда кинул, так как тестировал как их вытащить. Потом из этого файла будут по логин вытягиватся данные за месяц, на панель. Т.е. руководитель открывает панель, вводит ФИО сотрудника, и должны появится его показатели за 1 месяц.
Из сводной ведь нельзя так вытащить данные?
 
Ответить
СообщениеЧто касается скорости вы совершенно правы, сводная наилучший вариант. Там проблема в том, что таблица имеет определенный формат (своеобразная консолидации). Кнопку туда кинул, так как тестировал как их вытащить. Потом из этого файла будут по логин вытягиватся данные за месяц, на панель. Т.е. руководитель открывает панель, вводит ФИО сотрудника, и должны появится его показатели за 1 месяц.
Из сводной ведь нельзя так вытащить данные?

Автор - Vladimir32
Дата добавления - 06.02.2019 в 10:21
Roman777 Дата: Среда, 06.02.2019, 10:26 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Vladimir32, Проверил только по суммам, но вроде должно работать:
[vba]
Код
Sub Commonate()
    Dim i&, j&, tmp As Variant
    Dim o As Object, key$, oDates As Object, dat$
    Dim Names$(), k&
    Dim t(1 To 2) As Long
    Dim AllDates As Object, datas$(), k2&
    Dim tmpDat As Variant
    Set o = CreateObject("Scripting.dictionary")
    Set AllDates = CreateObject("Scripting.dictionary")
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        key = Cells(i, 1)
        dat = Format(Cells(i, 2), "MM.YYYY")
        If (Not o.exists(key)) Then
            k = k + 1
            ReDim Preserve Names(1 To k)
            Names(k) = key
            Set oDates = CreateObject("Scripting.dictionary")
            If (Not oDates.exists(dat)) Then
                For j = 1 To 2
                    t(j) = Cells(i, 2 + j)
                Next j
                oDates.Add dat, t
            Else
                Set tmp = oDates(dat)
                For j = 1 To 2
                    tmp(j) = tmp(j) + Cells(i, 2 + j)
                Next j
            End If
            o.Add key, oDates
        Else
            Set tmpDat = o(key)
            If (Not tmpDat.exists(dat)) Then
                For j = 1 To 2
                    t(j) = Cells(i, 2 + j)
                Next j
                tmpDat.Add dat, t
            Else
                tmp = tmpDat(dat)
                For j = 1 To 2
                    tmp(j) = tmp(j) + Cells(i, 2 + j)
                Next j
                tmpDat(dat) = tmp
            End If
            Set o(key) = tmpDat
        End If
        If (Not AllDates.exists(dat)) Then
            k2 = k2 + 1
            ReDim Preserve datas(1 To k2)
            datas(k2) = dat
            AllDates.Add dat, 1
        End If
    Next i
    k = UBound(Names)
    With Worksheets(2)
        For i = 1 To UBound(datas)
            For j = 1 To k
                k2 = i + (k - 1) * (i - 1) + j
                .Cells(k2, 1) = Names(j)
                If AllDates.exists(datas(i)) Then
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    Set tmp = o(Names(j))
                    .Cells(k2, 3) = tmp(datas(i))(1)
                    .Cells(k2, 4) = tmp(datas(i))(2)
                Else
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    .Cells(k2, 3) = 0
                    .Cells(k2, 4) = 0
                End If
            Next j
        Next i
    End With
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
СообщениеVladimir32, Проверил только по суммам, но вроде должно работать:
[vba]
Код
Sub Commonate()
    Dim i&, j&, tmp As Variant
    Dim o As Object, key$, oDates As Object, dat$
    Dim Names$(), k&
    Dim t(1 To 2) As Long
    Dim AllDates As Object, datas$(), k2&
    Dim tmpDat As Variant
    Set o = CreateObject("Scripting.dictionary")
    Set AllDates = CreateObject("Scripting.dictionary")
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        key = Cells(i, 1)
        dat = Format(Cells(i, 2), "MM.YYYY")
        If (Not o.exists(key)) Then
            k = k + 1
            ReDim Preserve Names(1 To k)
            Names(k) = key
            Set oDates = CreateObject("Scripting.dictionary")
            If (Not oDates.exists(dat)) Then
                For j = 1 To 2
                    t(j) = Cells(i, 2 + j)
                Next j
                oDates.Add dat, t
            Else
                Set tmp = oDates(dat)
                For j = 1 To 2
                    tmp(j) = tmp(j) + Cells(i, 2 + j)
                Next j
            End If
            o.Add key, oDates
        Else
            Set tmpDat = o(key)
            If (Not tmpDat.exists(dat)) Then
                For j = 1 To 2
                    t(j) = Cells(i, 2 + j)
                Next j
                tmpDat.Add dat, t
            Else
                tmp = tmpDat(dat)
                For j = 1 To 2
                    tmp(j) = tmp(j) + Cells(i, 2 + j)
                Next j
                tmpDat(dat) = tmp
            End If
            Set o(key) = tmpDat
        End If
        If (Not AllDates.exists(dat)) Then
            k2 = k2 + 1
            ReDim Preserve datas(1 To k2)
            datas(k2) = dat
            AllDates.Add dat, 1
        End If
    Next i
    k = UBound(Names)
    With Worksheets(2)
        For i = 1 To UBound(datas)
            For j = 1 To k
                k2 = i + (k - 1) * (i - 1) + j
                .Cells(k2, 1) = Names(j)
                If AllDates.exists(datas(i)) Then
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    Set tmp = o(Names(j))
                    .Cells(k2, 3) = tmp(datas(i))(1)
                    .Cells(k2, 4) = tmp(datas(i))(2)
                Else
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    .Cells(k2, 3) = 0
                    .Cells(k2, 4) = 0
                End If
            Next j
        Next i
    End With
End Sub
[/vba]

Автор - Roman777
Дата добавления - 06.02.2019 в 10:26
_Boroda_ Дата: Среда, 06.02.2019, 10:48 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 14954
Репутация: 5916 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Из сводной ведь нельзя так вытащить данные?

Льзя. Смотрите файл

И в следующий раз не нужно вот этих подходов издалека. Сразу говорите что конкретно нужно
К сообщению приложен файл: 123456_2.xlsm(20.2 Kb)


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

Льзя. Смотрите файл

И в следующий раз не нужно вот этих подходов издалека. Сразу говорите что конкретно нужно

Автор - _Boroda_
Дата добавления - 06.02.2019 в 10:48
Vladimir32 Дата: Среда, 06.02.2019, 15:32 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, спасибо! Очень удобно получилось.
 
Ответить
Сообщение_Boroda_, спасибо! Очень удобно получилось.

Автор - Vladimir32
Дата добавления - 06.02.2019 в 15:32
Vladimir32 Дата: Среда, 06.02.2019, 15:34 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Roman777, спасибо за макрос, сумму он считает отлично. А вот вопрос, я пытался его "поковырять", чтобы он кол-во считал, но не получается(
 
Ответить
СообщениеRoman777, спасибо за макрос, сумму он считает отлично. А вот вопрос, я пытался его "поковырять", чтобы он кол-во считал, но не получается(

Автор - Vladimir32
Дата добавления - 06.02.2019 в 15:34
Roman777 Дата: Среда, 06.02.2019, 20:51 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Vladimir32, добрый вечер!
я пытался его "поковырять", чтобы он кол-во считал, но не получается

а я не вижу, где Вы пытались...) А про какое количество идёт речь?


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Среда, 06.02.2019, 20:57
 
Ответить
СообщениеVladimir32, добрый вечер!
я пытался его "поковырять", чтобы он кол-во считал, но не получается

а я не вижу, где Вы пытались...) А про какое количество идёт речь?

Автор - Roman777
Дата добавления - 06.02.2019 в 20:51
Vladimir32 Дата: Четверг, 07.02.2019, 07:50 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Файл пока не могу приложить, с рабочего компьютера нельзя файлы прикладывать, в столбце оценка есть стоят оценки от 1 до 5, и нужно посчитать количество оценок, а не сумму.
 
Ответить
СообщениеФайл пока не могу приложить, с рабочего компьютера нельзя файлы прикладывать, в столбце оценка есть стоят оценки от 1 до 5, и нужно посчитать количество оценок, а не сумму.

Автор - Vladimir32
Дата добавления - 07.02.2019 в 07:50
Roman777 Дата: Четверг, 07.02.2019, 11:26 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Vladimir32, поидее так должно работать:
[vba]
Код
Sub Commonate()
    Dim i&, j&, tmp As Variant
    Dim o As Object, key$, oDates As Object, dat$
    Dim Names$(), k&
    Dim t(1 To 2) As Long
    Dim AllDates As Object, datas$(), k2&
    Dim tmpDat As Variant
    Set o = CreateObject("Scripting.dictionary")
    Set AllDates = CreateObject("Scripting.dictionary")
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        key = Cells(i, 1)
        dat = Format(Cells(i, 2), "MM.YYYY")
        If (Not o.exists(key)) Then
            k = k + 1
            ReDim Preserve Names(1 To k)
            Names(k) = key
            Set oDates = CreateObject("Scripting.dictionary")
            If (Not oDates.exists(dat)) Then
                    t(1) = Cells(i, 3)
                    t(2) = 1
                oDates.Add dat, t
            Else
                Set tmp = oDates(dat)
                    tmp(1) = tmp(1) + Cells(i, 3)
                    tmp(2) = tmp(2) + 1
            End If
            o.Add key, oDates
        Else
            Set tmpDat = o(key)
            If (Not tmpDat.exists(dat)) Then
                    t(1) = Cells(i, 3)
                    t(2) = 1
                tmpDat.Add dat, t
            Else
                tmp = tmpDat(dat)
                
                    tmp(1) = tmp(1) + Cells(i, 3)
                    tmp(2) = tmp(2) + 1
                tmpDat(dat) = tmp
            End If
            Set o(key) = tmpDat
        End If
        If (Not AllDates.exists(dat)) Then
            k2 = k2 + 1
            ReDim Preserve datas(1 To k2)
            datas(k2) = dat
            AllDates.Add dat, 1
        End If
    Next i
    k = UBound(Names)
    With Worksheets(2)
        For i = 1 To UBound(datas)
            For j = 1 To k
                k2 = i + (k - 1) * (i - 1) + j
                .Cells(k2, 1) = Names(j)
                If AllDates.exists(datas(i)) Then
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    Set tmp = o(Names(j))
                    .Cells(k2, 3) = tmp(datas(i))(1)
                    .Cells(k2, 4) = tmp(datas(i))(2)
                Else
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    .Cells(k2, 3) = 0
                    .Cells(k2, 4) = 0
                End If
            Next j
        Next i
    End With
End Sub
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Четверг, 07.02.2019, 11:28
 
Ответить
СообщениеVladimir32, поидее так должно работать:
[vba]
Код
Sub Commonate()
    Dim i&, j&, tmp As Variant
    Dim o As Object, key$, oDates As Object, dat$
    Dim Names$(), k&
    Dim t(1 To 2) As Long
    Dim AllDates As Object, datas$(), k2&
    Dim tmpDat As Variant
    Set o = CreateObject("Scripting.dictionary")
    Set AllDates = CreateObject("Scripting.dictionary")
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        key = Cells(i, 1)
        dat = Format(Cells(i, 2), "MM.YYYY")
        If (Not o.exists(key)) Then
            k = k + 1
            ReDim Preserve Names(1 To k)
            Names(k) = key
            Set oDates = CreateObject("Scripting.dictionary")
            If (Not oDates.exists(dat)) Then
                    t(1) = Cells(i, 3)
                    t(2) = 1
                oDates.Add dat, t
            Else
                Set tmp = oDates(dat)
                    tmp(1) = tmp(1) + Cells(i, 3)
                    tmp(2) = tmp(2) + 1
            End If
            o.Add key, oDates
        Else
            Set tmpDat = o(key)
            If (Not tmpDat.exists(dat)) Then
                    t(1) = Cells(i, 3)
                    t(2) = 1
                tmpDat.Add dat, t
            Else
                tmp = tmpDat(dat)
                
                    tmp(1) = tmp(1) + Cells(i, 3)
                    tmp(2) = tmp(2) + 1
                tmpDat(dat) = tmp
            End If
            Set o(key) = tmpDat
        End If
        If (Not AllDates.exists(dat)) Then
            k2 = k2 + 1
            ReDim Preserve datas(1 To k2)
            datas(k2) = dat
            AllDates.Add dat, 1
        End If
    Next i
    k = UBound(Names)
    With Worksheets(2)
        For i = 1 To UBound(datas)
            For j = 1 To k
                k2 = i + (k - 1) * (i - 1) + j
                .Cells(k2, 1) = Names(j)
                If AllDates.exists(datas(i)) Then
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    Set tmp = o(Names(j))
                    .Cells(k2, 3) = tmp(datas(i))(1)
                    .Cells(k2, 4) = tmp(datas(i))(2)
                Else
                    .Cells(k2, 2) = MonthName(Month(datas(i))) & " " & Year(datas(i))
                    .Cells(k2, 3) = 0
                    .Cells(k2, 4) = 0
                End If
            Next j
        Next i
    End With
End Sub
[/vba]

Автор - Roman777
Дата добавления - 07.02.2019 в 11:26
Vladimir32 Дата: Четверг, 07.02.2019, 13:37 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 33
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Роман, это то что нужно наиогромнейшее спасибо!
 
Ответить
СообщениеРоман, это то что нужно наиогромнейшее спасибо!

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

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