Здравствуйте. Для ведения статистики хочу подсчитать количество игр у теннисистов. В столбце" A" игрок победитель, в столбце "B", проигравший. В столбце "C" дата матча. В столбце "E" нужно получить количество матчей по текущую дату для первого игрока, с учётом того что периодически он может быть как победителем, так и проигравшим, т.е нужно учитывать ещё и столбец "B". Аналогично для второго игрока, результат занести в столбец "F." На перспективу ещё можно сделать такой же расчет с учётом текущего покрытия (хард, грунт, трава) - значения столбца "D". С помощью формулы счетеслимн посчитать легко, но из-за потенциально большого набора данных хотелось бы делать расчет с помощью макроса. После выполнения макроса нужно получить такие же значения как в E:H. Нашел что это как-то можно сделать с помощью Application.WorksheetFunction.CountIf, но не понял как именно. Может кто подскажет. В примере есть какие-то попытки кода
Здравствуйте. Для ведения статистики хочу подсчитать количество игр у теннисистов. В столбце" A" игрок победитель, в столбце "B", проигравший. В столбце "C" дата матча. В столбце "E" нужно получить количество матчей по текущую дату для первого игрока, с учётом того что периодически он может быть как победителем, так и проигравшим, т.е нужно учитывать ещё и столбец "B". Аналогично для второго игрока, результат занести в столбец "F." На перспективу ещё можно сделать такой же расчет с учётом текущего покрытия (хард, грунт, трава) - значения столбца "D". С помощью формулы счетеслимн посчитать легко, но из-за потенциально большого набора данных хотелось бы делать расчет с помощью макроса. После выполнения макроса нужно получить такие же значения как в E:H. Нашел что это как-то можно сделать с помощью Application.WorksheetFunction.CountIf, но не понял как именно. Может кто подскажет. В примере есть какие-то попытки кодаolegori1993
Dim wf As WorksheetFunction Dim wks As Worksheet Dim lob As ListObject Dim lcs As ListColumns
Dim cPlayer1 As Range Dim cPlayer2 As Range Dim cDatum As Range Dim cCort As Range Dim cGP1 As Range Dim cGP2 As Range Dim cGP1_C As Range Dim cGP2_C As Range Dim player As String Dim dtcond As String
Set wf = Application.WorksheetFunction
Set wks = Worksheets("Лист1") Set lob = wks.ListObjects(1) Set lcs = lob.ListColumns
Set cPlayer1 = lcs("Player1").DataBodyRange Set cPlayer2 = lcs("Player2").DataBodyRange Set cDatum = lcs("Date").DataBodyRange Set cCort = lcs("Cort").DataBodyRange
Set cGP1 = lcs("GP1").DataBodyRange Set cGP2 = lcs("GP2").DataBodyRange Set cGP1_C = lcs("GP1_C").DataBodyRange Set cGP2_C = lcs("GP2_C").DataBodyRange
For i = 1 To lob.ListRows.count dtcond = "<" & CLng(cDatum(i))
player = cPlayer2(i) cGP2(i) = wf.CountIfs(cPlayer1, player, cDatum, dtcond) _ + wf.CountIfs(cPlayer2, player, cDatum, dtcond) cGP2_C(i) = wf.CountIfs(cPlayer1, player, cDatum, dtcond, cCort, cCort(i)) _ + wf.CountIfs(cPlayer2, player, cDatum, dtcond, cCort, cCort(i)) Next i End Sub
[/vba]
Как-то так: [vba]
Код
Sub Кнопка1_Щелчок() Dim i As Long
Dim wf As WorksheetFunction Dim wks As Worksheet Dim lob As ListObject Dim lcs As ListColumns
Dim cPlayer1 As Range Dim cPlayer2 As Range Dim cDatum As Range Dim cCort As Range Dim cGP1 As Range Dim cGP2 As Range Dim cGP1_C As Range Dim cGP2_C As Range Dim player As String Dim dtcond As String
Set wf = Application.WorksheetFunction
Set wks = Worksheets("Лист1") Set lob = wks.ListObjects(1) Set lcs = lob.ListColumns
Set cPlayer1 = lcs("Player1").DataBodyRange Set cPlayer2 = lcs("Player2").DataBodyRange Set cDatum = lcs("Date").DataBodyRange Set cCort = lcs("Cort").DataBodyRange
Set cGP1 = lcs("GP1").DataBodyRange Set cGP2 = lcs("GP2").DataBodyRange Set cGP1_C = lcs("GP1_C").DataBodyRange Set cGP2_C = lcs("GP2_C").DataBodyRange
For i = 1 To lob.ListRows.count dtcond = "<" & CLng(cDatum(i))
В итоге сам нашел довольно простое решение на основе другого когда. Но появилась еще задача посчитать количество скажем за определенный промежуток времени, например за прошлые 60 дней от текущей даты. Как я понял нужно менять диапазон для цикла, но не придумал как это сделать. Что нужно добавить в код (или как-то его изменить) чтобы выполнялся необходимый расчет? Можно добавить туда же, а можно отдельным макросом. В данном случае пример упростил.
В итоге сам нашел довольно простое решение на основе другого когда. Но появилась еще задача посчитать количество скажем за определенный промежуток времени, например за прошлые 60 дней от текущей даты. Как я понял нужно менять диапазон для цикла, но не придумал как это сделать. Что нужно добавить в код (или как-то его изменить) чтобы выполнялся необходимый расчет? Можно добавить туда же, а можно отдельным макросом. В данном случае пример упростил.noelnoel93
Ну, Вы прямо Олимпиаду по программированию тут устраиваете. В первом задании речь шла о том, чтобы "запустить" внутри макроса расчет табличной функции CountIfs. Об оптимизации и о перевариваемых объёмах (типа 30K) вопрос пока не ставился.
Второй же пример отличается от первого как день и ночь. Если бы Вы его в таком виде сразу представили, то уже и получили бы решение на основе словаря. Но у Вас же там еще зависимость от даты была ("< даты текущей строки"), а Вы в курсе, что там есть дни, когда один игрок проводит несколько встреч (например, Marinko Matosevic - 2 игры за 09.01.2010) ? Поэтому по первоначальному алгоритму все строки одного дня для одного игрока были одинаковыми, поскольку считали кол-ва по предыдущий день, не учитывая текущий. А в словарном решении, например, результат напротив "утренней" встречи этого игрока внутри одной даты будет меньше результата напротив "вечерней", потому что вечерняя будет учитывать уже и утреннюю (просто как некую предыдущую строку в общем списке с этим игроком).
А вот теперь я запасаюсь попкорном и колой, устраиваюсь поудобнее в кресле и понаблюдаю, как в словарное решение можно добавить элегантный учет условия "текДата - 60 дней", не задействуя функцию СЧЁТЕСЛИМН (в любой ипостаси - в формуле в ячейке или в коде VBA).
[p.s.]Эх, добрый я человек... См. в коде врезку "подсчет текДата - 60"[/p.s.] [vba]
Код
Sub Кнопка1_Щелчок() Dim aGame, i As Long, j As Long Dim rGame As Range Dim dict As Object, count, count60d As Double
Set rGame = ActiveSheet.ListObjects(1).DataBodyRange aGame = rGame.Value Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aGame, 1) ' обсчет If dict.exists(aGame(i, 1)) Then aGame(i, 3) = dict(aGame(i, 1)) Else ' игрока нет в списке aGame(i, 3) = 0 End If
count = 1 'счетчик игр
dict(aGame(i, 1)) = aGame(i, 3) + count ' число игр
'*** подсчет текДата - 60 *** count = 0 For j = 1 To i - 1 If aGame(j, 1) = aGame(i, 1) And _ aGame(j, 2) >= aGame(i, 2) - 60 And _ aGame(j, 2) < aGame(i, 2) Then count = count + 1 End If Next j aGame(i, 4) = count '**************************** Next i
rGame.Value = aGame Set dict = Nothing
End Sub
[/vba]Но общее время выполнения, конечно, заметно увеличивается.
Ну, Вы прямо Олимпиаду по программированию тут устраиваете. В первом задании речь шла о том, чтобы "запустить" внутри макроса расчет табличной функции CountIfs. Об оптимизации и о перевариваемых объёмах (типа 30K) вопрос пока не ставился.
Второй же пример отличается от первого как день и ночь. Если бы Вы его в таком виде сразу представили, то уже и получили бы решение на основе словаря. Но у Вас же там еще зависимость от даты была ("< даты текущей строки"), а Вы в курсе, что там есть дни, когда один игрок проводит несколько встреч (например, Marinko Matosevic - 2 игры за 09.01.2010) ? Поэтому по первоначальному алгоритму все строки одного дня для одного игрока были одинаковыми, поскольку считали кол-ва по предыдущий день, не учитывая текущий. А в словарном решении, например, результат напротив "утренней" встречи этого игрока внутри одной даты будет меньше результата напротив "вечерней", потому что вечерняя будет учитывать уже и утреннюю (просто как некую предыдущую строку в общем списке с этим игроком).
А вот теперь я запасаюсь попкорном и колой, устраиваюсь поудобнее в кресле и понаблюдаю, как в словарное решение можно добавить элегантный учет условия "текДата - 60 дней", не задействуя функцию СЧЁТЕСЛИМН (в любой ипостаси - в формуле в ячейке или в коде VBA).
[p.s.]Эх, добрый я человек... См. в коде врезку "подсчет текДата - 60"[/p.s.] [vba]
Код
Sub Кнопка1_Щелчок() Dim aGame, i As Long, j As Long Dim rGame As Range Dim dict As Object, count, count60d As Double
Set rGame = ActiveSheet.ListObjects(1).DataBodyRange aGame = rGame.Value Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aGame, 1) ' обсчет If dict.exists(aGame(i, 1)) Then aGame(i, 3) = dict(aGame(i, 1)) Else ' игрока нет в списке aGame(i, 3) = 0 End If
count = 1 'счетчик игр
dict(aGame(i, 1)) = aGame(i, 3) + count ' число игр
'*** подсчет текДата - 60 *** count = 0 For j = 1 To i - 1 If aGame(j, 1) = aGame(i, 1) And _ aGame(j, 2) >= aGame(i, 2) - 60 And _ aGame(j, 2) < aGame(i, 2) Then count = count + 1 End If Next j aGame(i, 4) = count '**************************** Next i
rGame.Value = aGame Set dict = Nothing
End Sub
[/vba]Но общее время выполнения, конечно, заметно увеличивается.Gustav
Извините, я сюда пишу потому что мало что понимаю в кодах, не хотел никого обидеть. Очень хорошо что есть такие люди как вы, которые могут помочь в решениях разных вопросов, за что огромное спасибо. А какое вы бы могли предложить решение с учетом оптимизации на большой объем данных? Если такой вообще есть. Лучше использовать файл из первого сообщения
Извините, я сюда пишу потому что мало что понимаю в кодах, не хотел никого обидеть. Очень хорошо что есть такие люди как вы, которые могут помочь в решениях разных вопросов, за что огромное спасибо. А какое вы бы могли предложить решение с учетом оптимизации на большой объем данных? Если такой вообще есть. Лучше использовать файл из первого сообщенияnoelnoel93
Сообщение отредактировал noelnoel93 - Воскресенье, 31.07.2022, 19:22
А какое вы бы могли предложить решение с учетом оптимизации на большой объем данных? Если такой вообще есть. Лучше использовать файл из первого сообщения
Вот такой у меня получился "слегка оптимизированный" код, отрабатывает за 7 минут на 29 тыс. записей: [vba]
Код
Sub test3() Dim i As Long
Dim wf As WorksheetFunction Dim wks As Worksheet Dim lob As ListObject Dim lcs As ListColumns
Dim cPlayer1 As Range Dim cPlayer2 As Range Dim cDatum As Range Dim cCort As Range Dim cGP1 As Range Dim cGP2 As Range Dim cGP1_C As Range Dim cGP2_C As Range Dim player As String Dim dtcond As String Dim time1 As Date
Dim aPlayer1 As Variant Dim aPlayer2 As Variant Dim aDatum As Variant Dim aCort As Variant Dim aGP1 As Variant Dim aGP2 As Variant Dim aGP1_C As Variant Dim aGP2_C As Variant
time1 = Now
Application.ScreenUpdating = False
Set wf = Application.WorksheetFunction
Set wks = Worksheets("Лист1") Set lob = wks.ListObjects(1) Set lcs = lob.ListColumns
Set cPlayer1 = lcs("Player1").DataBodyRange Set cPlayer2 = lcs("Player2").DataBodyRange Set cDatum = lcs("Date").DataBodyRange Set cCort = lcs("Cort").DataBodyRange
Set cGP1 = lcs("GP1").DataBodyRange Set cGP2 = lcs("GP2").DataBodyRange Set cGP1_C = lcs("GP1_C").DataBodyRange Set cGP2_C = lcs("GP2_C").DataBodyRange
А какое вы бы могли предложить решение с учетом оптимизации на большой объем данных? Если такой вообще есть. Лучше использовать файл из первого сообщения
Вот такой у меня получился "слегка оптимизированный" код, отрабатывает за 7 минут на 29 тыс. записей: [vba]
Код
Sub test3() Dim i As Long
Dim wf As WorksheetFunction Dim wks As Worksheet Dim lob As ListObject Dim lcs As ListColumns
Dim cPlayer1 As Range Dim cPlayer2 As Range Dim cDatum As Range Dim cCort As Range Dim cGP1 As Range Dim cGP2 As Range Dim cGP1_C As Range Dim cGP2_C As Range Dim player As String Dim dtcond As String Dim time1 As Date
Dim aPlayer1 As Variant Dim aPlayer2 As Variant Dim aDatum As Variant Dim aCort As Variant Dim aGP1 As Variant Dim aGP2 As Variant Dim aGP1_C As Variant Dim aGP2_C As Variant
time1 = Now
Application.ScreenUpdating = False
Set wf = Application.WorksheetFunction
Set wks = Worksheets("Лист1") Set lob = wks.ListObjects(1) Set lcs = lob.ListColumns
Set cPlayer1 = lcs("Player1").DataBodyRange Set cPlayer2 = lcs("Player2").DataBodyRange Set cDatum = lcs("Date").DataBodyRange Set cCort = lcs("Cort").DataBodyRange
Set cGP1 = lcs("GP1").DataBodyRange Set cGP2 = lcs("GP2").DataBodyRange Set cGP1_C = lcs("GP1_C").DataBodyRange Set cGP2_C = lcs("GP2_C").DataBodyRange
Много... 350к. Мб проще это посчитать в power pivot. Я там и считал, но просто это всего лишь часть расчетов, которые будут использовать для рейтинга ЭЛО. Эта часть у меня на макросе есть, а вот в power pivot не нашел как его можно рассчитать. Поэтому решил на vba попробовать.
Много... 350к. Мб проще это посчитать в power pivot. Я там и считал, но просто это всего лишь часть расчетов, которые будут использовать для рейтинга ЭЛО. Эта часть у меня на макросе есть, а вот в power pivot не нашел как его можно рассчитать. Поэтому решил на vba попробовать.olegori1993
Скорее, не Pivot, а Query - в этой задаче полно вертикальных вычислений. Но тут я не помощник - не владею ни тем, ни другим. Я бы, скорее, всё это хозяйство в какую-нибудь доступную СУБД отправил, в тот же Access...
Хотя, если не требуются ежеминутные глобальные пересчеты, то можно и в Excel по частям за пару-тройку часов и 350к обсчитать.
Скорее, не Pivot, а Query - в этой задаче полно вертикальных вычислений. Но тут я не помощник - не владею ни тем, ни другим. Я бы, скорее, всё это хозяйство в какую-нибудь доступную СУБД отправил, в тот же Access...
Хотя, если не требуются ежеминутные глобальные пересчеты, то можно и в Excel по частям за пару-тройку часов и 350к обсчитать.Gustav
Спасибо в любом случае. Буду думать как лучше. А можете показать как будет выглядеть ваш второй вариант для расчета за 60 дней, но для первой таблицы. Там где две колонки с игроками
Спасибо в любом случае. Буду думать как лучше. А можете показать как будет выглядеть ваш второй вариант для расчета за 60 дней, но для первой таблицы. Там где две колонки с игрокамиolegori1993
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
