|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Посчитать количество повторяющихся записей в массиве или другой вариант решения |
|
VBA - Посчитать количество повторяющихся записей в массиве или другой вариант решения
|
Старожил Сообщения: 329 |
Профиль | Отправить PM | Цитировать
В общем в экселе есть макрос, который подключается к серверу и при помощи запроса скачивает данные таблицы в массив. Необходимо посчитать количество каждой повторяющейся записи. Записи распологаются в разнобой и простым перебором не получится посчитать.
результирующие кол-ва надо записывать в соседний столбец. Если возможно это делать во время запроса как то, то будет идеально. Если нет, то нужен быстрый способ, то есть не перебор массива, и сделать это в виде отдельной функции, чтоб на входе один массив, на выходе другой. |
|
------- Отправлено: 12:31, 04-09-2017 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Какой макрос? Что за сервер? Какой запрос? Что понимать под «каждой повторяющейся записью»?
|
Отправлено: 13:07, 04-09-2017 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать |
------- Отправлено: 14:20, 04-09-2017 | #3 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать blackeangel, там, выше, четыре вопроса.
|
Отправлено: 14:27, 04-09-2017 | #4 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Iska,
Макрос таков Sub KD() Dim arr1() Application.ScreenUpdating = False ncolumn = Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlWhole).Column Columns(ncolumn + 1).Insert Cells(1, ncolumn + 1).Value = "Карточки" m = ActiveSheet.Cells(Rows.Count, ncolumn).End(xlUp).Row Set rn = ActiveSheet.Cells(2, ncolumn).Resize(m, 2) arr2 = rn.Value Set conn = New ADODB.Connection conn.ConnectionString = "Provider=*;Password=*;Persist Security Info=True;User ID=User_for_macros_PDM;Initial Catalog=db_pdm_ScanKD;Data Source=RTVS-SQL05" 'Строка подключения conn.Open Set rst = New ADODB.Recordset rst.ActiveConnection = conn Ask = "SELECT [Oboznach],[Count_page],[ScanFile] FROM [db_pdm_ScanKD].[dbo].[pdm_vwScanKD] Where Not ([Oboznach] Like '%СБ'or [Oboznach] Like '%ТУ' or [Oboznach] Like '%ИМ' or [Oboznach] Like '%ДИ' or [Oboznach] Like '%РР' or [Oboznach] Like '%РИ' or [Oboznach] Like '%УД' or [Oboznach] Like '%ЛУ' or [Oboznach] Like '%ТБ' or [Oboznach] Like '%Э3' or [Oboznach] Like '%ПЭ3' or [Oboznach] Like '%Д7' or [Oboznach] Like '%К3' or [Oboznach] Like '%Д4' or [Oboznach] Like '%ДП' or [Oboznach] Like '%РИ' or [Oboznach] Like '%ПГ3' or [Oboznach] Like '%ПГ4' or [Oboznach] Like '%Г4' or [Oboznach] Like '%ПГ3' or [Oboznach] Like '%Э4' or [Oboznach] Like '%ТЭ4' or [Oboznach] Like '%ПИ' or [Oboznach] Like '%И2')" rst.Open Ask, conn, adOpenStatic, adLockBatchOptimistic arr1 = rst.GetRows conn.Close arr1 = TransposeDim(arr1) For i = LBound(arr1) To UBound(arr1) For j = LBound(arr2) To UBound(arr2) If Len(arr2(j, 1)) > 0 Then If InStr(1, arr2(j, 1), arr1(i, 0), vbTextCompare) > 0 Then arr2(j, 2) = arr1(i, 0) End If End If Next j Next i ActiveSheet.Cells(2, ncolumn).Resize(UBound(arr2), UBound(arr2, 2)) = arr2 Application.ScreenUpdating = True End Sub |
|
------- Отправлено: 14:33, 04-09-2017 | #5 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать Смотрите, Вам нужно использовать запрос с группировкой (GROUP BY) и выражением Count(*) для подсчёта записей. А если диалект позволяет — то можно сократить кучу «[Oboznach] Like '%…'» до нескольких выражений (но это не суть важное). Наподобие:
Скрытый текст
У Вас, кстати, в запросе дважды повторяется «ПГ3». |
Отправлено: 15:07, 04-09-2017 | #6 |
Старожил Сообщения: 329
|
Профиль | Отправить PM | Цитировать Iska,
Как то так? Sub KD() Dim arr1() Application.ScreenUpdating = False ncolumn = Rows(1).Find(What:="Обозначение", LookIn:=xlValues, LookAt:=xlWhole).Column Columns(ncolumn + 1).Insert Cells(1, ncolumn + 1).Value = "Карточки" m = ActiveSheet.Cells(Rows.Count, ncolumn).End(xlUp).Row Set rn = ActiveSheet.Cells(2, ncolumn).Resize(m, 2) arr2 = rn.Value Set conn = New ADODB.Connection conn.ConnectionString = "Provider=*;Password=*;Persist Security Info=True;User ID=User_for_macros_PDM;Initial Catalog=db_pdm_ScanKD;Data Source=RTVS-SQL05" 'Строка подключения conn.Open Set rst = New ADODB.Recordset rst.ActiveConnection = conn Ask = "SELECT [Oboznach],[Count_page], COUNT(*) as КоличествоЗаписей " _ & "FROM [db_pdm_ScanKD].[dbo].[pdm_vwScanKD] " _ & "Where Not ([Oboznach] Like '%СБ'or [Oboznach] Like '%ТУ' or [Oboznach] Like '%ИМ' or [Oboznach] Like '%ДИ' or [Oboznach] Like '%РР' or [Oboznach] Like '%РИ' or [Oboznach] Like '%УД' or [Oboznach] Like '%ЛУ' or [Oboznach] Like '%ТБ' or [Oboznach] Like '%Э3' or [Oboznach] Like '%ПЭ3' or [Oboznach] Like '%Д7' or [Oboznach] Like '%К3' or [Oboznach] Like '%Д4' or [Oboznach] Like '%ДП' or [Oboznach] Like '%РИ' or [Oboznach] Like '%ПГ3' or [Oboznach] Like '%ПГ4' or [Oboznach] Like '%Г4' or [Oboznach] Like '%Э4' or [Oboznach] Like '%ТЭ4' or [Oboznach] Like '%ПИ' or [Oboznach] Like '%И2') " _ & " GROUP BY [Oboznach],[Count_page]" rst.Open Ask, conn, adOpenStatic, adLockBatchOptimistic ActiveSheet.Cells(2, ncolumn).copyfromrecordset rst Application.ScreenUpdating = True End Sub |
------- Отправлено: 18:18, 04-09-2017 | #7 |
Ветеран Сообщения: 27449
|
Профиль | Отправить PM | Цитировать |
Отправлено: 19:11, 04-09-2017 | #8 |
Участник сейчас на форуме | Участник вне форума | Автор темы | Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
Прочее - Как посчитать количество вхождений при тайлинг в секунду | SyCraft | Общий по Linux | 1 | 11-02-2011 12:24 | |
CMD/BAT - [решено] посчитать количество каталогов на локальном диске через for | csusha | Скриптовые языки администрирования Windows | 3 | 18-09-2010 15:20 | |
Посчитать количество файлов в папке | Lodoss | AutoIt | 10 | 21-08-2009 04:12 | |
C/C++ - посчитать количество символов без пробела | ShadowMas | Программирование и базы данных | 5 | 07-05-2009 10:51 | |
[решено] Вариант решения конфликта IE7 и RunOnceEx | Kirk Hammett | Автоматическая установка Windows 2000/XP/2003 | 5 | 17-04-2007 17:40 |
|