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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

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

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

Какой макрос? Что за сервер? Какой запрос? Что понимать под «каждой повторяющейся записью»?

Цитата:

Что понимать под «каждой повторяющейся записью»?

Например,

Код:

М

М

М

М

М

На выходе

Код:

М

М

М

М

М 5

blackeangel, там, выше, четыре вопроса.

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

Смотрите, Вам нужно использовать запрос с группировкой (GROUP BY) и выражением Count(*) для подсчёта записей. А если диалект позволяет — то можно сократить кучу «[Oboznach] Like '%…'» до нескольких выражений (но это не суть важное). Наподобие:

Скрытый текст

У Вас, кстати, в запросе дважды повторяется «ПГ3».

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

Только один вопрос - как сократить кол-во Like?

Цитата:

Цитата blackeangel

Как то так? »

Если работает — то так. Но вообще должно быть не WHERE, а HAVING. У меня-то ведь нету этой базы, посему могу рассуждать токмо умозрительно.

Цитата:

Цитата blackeangel

Только один вопрос - как сократить кол-во Like? »

Провайдер-то кто, что за база?