Посчитать количество повторяющихся записей в массиве или другой вариант решения

@blackeangel · Регистрация: 22.07.2015

Студворк — интернет-сервис помощи студентам

В общем в экселе есть макрос, который подключается к серверу и при помощи запроса скачивает данные таблицы в массив. Необходимо посчитать количество каждой повторяющейся записи. Записи распологаются в разнобой и простым перебором не получится посчитать.
результирующие кол-ва надо записывать в соседний столбец. Если возможно это делать во время запроса как то, то будет идеально. Если нет, то нужен быстрый способ, то есть не перебор массива, и сделать это в виде отдельной функции, чтоб на входе один массив, на выходе другой.

mobile · 04.09.2017, 13:34

Наверняка в запросе есть поле, или несколько полей, по которым Вы определяете повторяющиеся записи. Тогда запрос, подсчитывающий количество записей в группах, должен включать группировку по этим полям и агрегатную функцию Count

SQL
1
2
3
SELECT Поле1, Поле2, COUNT(*) AS Количество 
FROM Таблица
GROUP BY Поле1, Поле2

@blackeangel · 04.09.2017, 13:44 **[ТС]**

mobile, а кол-во куда будет записываться?

mobile · 04.09.2017, 14:00

Сообщение от blackeangel

а кол-во куда будет записываться?

Так Вы же сами написали в первом мессадже:

Сообщение от blackeangel

в экселе есть макрос, который подключается к серверу и при помощи запроса скачивает данные таблицы в массив.

Видимо в этом массиве и будут. Только заменить SQL-текст запроса на запрос с группировками. Далее записываете в цикле массив на лист.

@blackeangel · 04.09.2017, 14:34 **[ТС]**

mobile, хорошо, откуда взять кол-во?

Code
1
SELECT Поле1, Поле2, COUNT(*) AS Количество

Или это кол-во чего?

Добавлено через 17 минут
mobile, а то особо не понятно как это завязать с этим вот

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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

mobile · 04.09.2017, 14:53

Дополнительных пояснений нет, поэтому будем считать, что все перечисленные поля группирующие. И воспользуемся методом CopyFromRecordset для записи полученного рекордсета на лист

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
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], 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 '%ПГ3' or [Oboznach] Like '%Э4' or [Oboznach] Like '%ТЭ4' or [Oboznach] Like '%ПИ' or [Oboznach] Like '%И2') " _
& " GROUP BY [Oboznach],[Count_page],[ScanFile]"
rst.Open Ask, conn, adOpenStatic, adLockBatchOptimistic
ActiveSheet.Cells(2, ncolumn).copyfromrecordset rst
 
'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

@blackeangel · 05.09.2017, 06:38 **[ТС]**

mobile, спасибо, то что нужно!

Добавлено через 14 часов 0 минут
mobile, а как сократить кол-во Like в данном случае?

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Логарифм записывается как: (x-2)log(x^2+2) - означает логарифм (x^2+2) по основанию (x-2). Унарный минус обозначается как ! в-строка - входное арифметическое выражение в инфиксной(обычной). . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908

	Посчитать количество повторяющихся записей в массиве или другой вариант решения 04.09.2017, 12:45. Показов 2755. Ответов 6 Метки нет (Все метки) В общем в экселе есть макрос, который подключается к серверу и при помощи запроса скачивает данные таблицы в массив. Необходимо посчитать количество каждой повторяющейся записи. Записи распологаются в разнобой и простым перебором не получится посчитать. результирующие кол-ва надо записывать в соседний столбец. Если возможно это делать во время запроса как то, то будет идеально. Если нет, то нужен быстрый способ, то есть не перебор массива, и сделать это в виде отдельной функции, чтоб на входе один массив, на выходе другой. 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	04.09.2017, 13:44 [ТС]
	mobile, а кол-во куда будет записываться? 0

@blackeangel 19 / 10 / 1 Регистрация: 22.07.2015 Сообщений: 908
	05.09.2017, 06:38 [ТС]
	mobile, спасибо, то что нужно! Добавлено через 14 часов 0 минут mobile, а как сократить кол-во Like в данном случае? 0

Посчитать количество повторяющихся записей в массиве или другой вариант решения

Решение