[решено] Создание макроса для поиска одинаковых значений в ячейках и укомплектовывания

[dyshes90]

Доброго времени суток уважаемые форумчане.
Существует проблема в написании макроса в Excel.
Честно говоря я немного далек от этого, лет 5 не занимался подобным и тупо все забыл.
Необходимо создать макрос для поиска и сортировки наименований таблицы и записывать их в отдельные строки.
Пример, как это должно быть в пристежке.
Т.е. макрос должен найти одинаковые значения во всем столбце (до 100 строк) и перенести наименование, ячейку и количество, для каждого наименования отдельно.
Люди добрые, помогите кто чем может)) Может кто писал подобное....

[Iska]

dyshes90, ничего не понятно. Где в Вашем примере находится:
во всем столбце (до 100 строк) »
?

[dyshes90]

Это столбец С, там могут находиться до 100 наименований.

[Iska]

dyshes90, ну, так покажите какой-нибудь реальный пример. Ибо в том, что Вы привели, нет никаких повторов, и совершенно непонятно, откуда берётся «1», и откуда — «8».

[dyshes90]

Вот что-то подобное, физических ячеек к которым привязывается программа максимум будет 16, наименований в каждой вплоть до 100, макрос должен просканировать все значения наименования, найти одинаковые и запихнуть в отдельную табличку с указанием количества и к какой ячейке принадлежит

[Iska]

dyshes90, примерно ясно. Только выложите то же самое в виде документа, а не изображения.

[dyshes90]

Пожалуйста.

[dyshes90]

Товарищи форумчане, есть ли мысли по этому вопросу или глухо все как в танке?

[Iska]

Мысли есть. Дело осталось за малым: начать и закончить ;). То есть — проверить, возможна ли корректная реализация этих мыслей.

[a_axe]

dyshes90, я прошу прощения - а почему именно VBA, сводная таблица не подойдет?
Не скажу, что сильно "шуруплю" в сводных таблицах - но на первый взгляд вроде то, что Вы хотите. Или такая форма не подходит?

[Iska]

a_axe, на мой взгляд — вполне подойдёт. Но подождём мнения автора.

[dyshes90]

Доброго дня, сводная таблица впр не плохо, я рассматривал этот вариант, но в примере всего 3 ячейки, на деле их будет 16-20, не совсем удобно просматривать данные будет на ней, всетки с моим примером по проще.

[dyshes90]

Iska, Есть идеи какие-нибудь, сроки горят, начальство вазилин готовит для меня)

[Iska]

dyshes90, я не вижу, чем бы это было неудобно.

Iska, Есть идеи какие-нибудь »
Есть. Использовать предложенный вариант со сводной таблицей.

[dyshes90]

Iska, Нет, не катит, вариант не удачный, неудобный для работы. Закрываю тему если мыслей нет.....

[a_axe]

не совсем удобно просматривать данные будет на ней »
Что именно неудобно и как нужно изменить, чтобы стало удобно?

на деле их будет 16-20 »
действительно, к Вам даже просьба была в этой связи:
dyshes90, ну, так покажите какой-нибудь реальный пример. »

Как вариант - можно сделать 26 сводных (бред конечно, но раз возникло расплывчатое слово "удобно") сводных таблиц по одной на каждого смурфика-фиксика в стиле Вашего файла (вообще четких критериев Вы не дали, поэтому совпадение условное) - в приложенном файле зеленые таблички. Сразу говорю, что замучаетесь их обновлять при изменении данных.

Ну и промежуточный (нормальный ) вариант - сделать все же одну сводную таблицу слегка в другой компоновке (в приложенном файле синяя таблица). В ней нажатием на крестик можно разворачивать/сворачивать наименование фильма. Нужна позиция - развернули, не нужна - свернули. Обновлять ее нужно только один раз.

Не зная Ваших критериев, на основании несодержательных и неконкретных комментариев "вариант не удачный, неудобный для работы" вряд ли получится реализовать более вдумчивое решение, потрудитесь хотя бы сказать, что для Вас удобно, что нет. Если нет желания расписывать, что Вы хотите иметь на выходе - мыслей и предложений нет.

[dyshes90]

a_axe, Спасибо огромное за вариант, но сделал удобнее, раскидал каждое наименование на отдельный лист, сыровато получилось, но удобнее для работы на данный момент, буду добивать, если есть желание помочь, буду весьма признателен. Вот полурабочий файл.

[Iska]

dyshes90, мой вариант извлечения — посредством OLE DB (Office 2003):
Sub Sample()
Dim objConnection As Object
Dim objRecordSet1 As Object
Dim objRecordSet2 As Object

Dim objCurRegion As Range


Set objConnection = CreateObject("ADODB.Connection")

With objConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""
.Open
End With

Set objCurRegion = ThisWorkbook.Worksheets.Item("Адресная программа").Range("B2").CurrentRegion

Set objRecordSet1 = objConnection.Execute( _
"SELECT DISTINCT Наименование " & _
"FROM [Адресная программа$" & objCurRegion.Address(False, False) & "] " & _
"WHERE NOT Наименование IS NULL ORDER BY Наименование" _
)

Set objRecordSet2 = objConnection.Execute( _
"SELECT Наименование, Ячейки, Количество " & _
"FROM [Адресная программа$" & objCurRegion.Address(False, False) & "] " & _
"WHERE NOT Наименование IS NULL ORDER BY Наименование, Ячейки" _
)

Do Until objRecordSet1.EOF
Debug.Print objRecordSet1.Fields.Item("Наименование").Value

With objRecordSet2
.Filter = "Наименование='" & objRecordSet1.Fields.Item("Наименование").Value & "'"

Do Until .EOF
With .Fields
Debug.Print vbTab, .Item("Ячейки").Value, vbTab, .Item("Количество").Value
End With

.MoveNext
Loop
End With

objRecordSet1.MoveNext
Loop

Set objCurRegion = Nothing

objRecordSet2.Close
objRecordSet1.Close

objConnection.Close

Set objRecordSet2 = Nothing
Set objRecordSet1 = Nothing

Set objConnection = Nothing
End Sub

Необходимые условия: Рабочая книга должна быть сохранена (обращение идёт именно к файлу Рабочей книги, а не к открытой в Excel Рабочей книге, не к текущим и не сохранённым изменениям); столбец «Ячейки» должен быть заполнен значениями (т.е., не как в первом выложенном Вами варианте).

В коде присутствует жёсткая привязка к адресу — «B2», откуда берётся текущий диапазон для извлечения. Первый запрос («objRecordSet1») извлекает все уникальные Наименования, второй («objRecordSet2») — весь диапазон целиком. Затем происходит вывод второго запроса с группировкой строк по строкам первого запроса. Для упрощения понимания вывод делается в окно отладки («Ctrl-G»), без формирования вывода в ячейки.

[dyshes90]

Iska, спасибо!!! Пример в студию please)

[Iska]

dyshes90, дык, на Вашем же файле (http://forum.oszone.net/post-2461695.html#post2461695) делал. Только дозаполнил по паре отсутствующих значений в столбцах «Ячейки» и «Количество»: 121538.

На всякий случай повторюсь: вывод идёт в окно отладки «Immediate», нажмите «Alt-F11», затем «Ctrl-G».