Ru-Board.club
← Вернуться в раздел «Прикладное программирование»

» Excel VBA (часть 3)

Автор: Klaxonio
Дата сообщения: 20.09.2011 11:41
Уважаемые форумчане, нужна ваша помощ
При подключении к файлу базы 1С выдает ошибку

Цитата:
Run-time error '-2147417848 (80010108)':
Method 'Connect' of object 'IV8COMConnector3' failed


Код подключения

Код: Private Sub CommandButton2_Click()
Dim ComConnect As Object
Dim Basa As Object
Set ComConnect = CreateObject("v81.COMConnector")
Set Basa = ComConnect.Connect("File=""C:\InfoBase""; Usr=""####""; Pwd=""####""")
End Sub
Автор: asbo
Дата сообщения: 20.09.2011 12:16
Klaxonio

Цитата:
Что я делаю не так...

Снова вопросы в непрофильной теме... вот, что не так.

Причем здесь Ексель? Если подключение будет из Акса или, не дай Бог, из Ворда, то туда писать будете? Ошибку дает метод 1С. Вот у него и спрашивать надо. И не лениться гуглить
Автор: Quieteroks
Дата сообщения: 20.09.2011 12:19
SAS888


Цитата:
Во-первых, повторяться могут не только пары, но и тройки, четверки и т.д. Во-вторых, Вы так и не сказали, 1496 пар (или чего там) - это правильный результат, или нет?

В базе не должно быть троек, четверок и т.д...
Поэтому смело можно говорить о парах.
Результат не знаю какой правильный. Этого никто не знает к сожалению.


Цитата:
Т.е. в листе "Повторы" присутствуют уникальные строки? Такого быть не должно.

Быть не должно. Отсортировал 20 записей, действительно дубликаты... Но в разброс. Значит базу кто то не полностью отсортировал. Извеняюсь, сразу не проверил.


Цитата:
Т.е. мой макрос пропускает какие-то повторы?

Возможно. Но странно. Результаты действительно разняться на 16 пар.


Цитата:
когда Вас все устроит, тогда и напишу

Хорошо, давайте разбираться дальше.


Цитата:
P.S. Вы не сравнивали время выполнения предложенных Вам вариантов? Мне самому интересно.

Время не смотрел. Но вариант AndVGri немного быстрее обработал результаты. Ваш вариант немного дольше грузит систему создавая новую книгу. Возможно исключительно из-за этого.
Автор: asbo
Дата сообщения: 20.09.2011 13:23
Quieteroks
Я одним глазом поглядываю за развитием событий. Что-то наворочено во всех вариантах - немеряно... А особенно мне не нравится обилие операций через буфер обмена. С форматированием какие-то пляски...

Вот алгоритм:
Отсортировать список.
Добавить столбец слева.
Циклом по строкам (начиная со второй и сравнивая с предыдущей) отметить в нем дубли (будут и пары, и тройки etc).
Не сравнивать все поля одновременно, а поочереди.
Отсортировать по этому новому столбцу.
Сделать копию листа.
Из первого удалить дубли.
Из второго - уникальные.
Фсе.
Автор: Quieteroks
Дата сообщения: 20.09.2011 13:59
asbo
Это уже пляски с бубном.
Проще макросом все обработать.

Мой алгоритм был недоработан, не обрабатывал все строки. Ребята помогли, массив отлично обрабатывает все строки. Единственное возможно доработать массив.

Может проще всего было бы делать как я, построчно копировать. Время не столь важный фактор. Вручную все это обрабатывается в милионы раз дольше. Знать бы как они алгоритм построили. Алгоритм более универсальный, работает без сортировки.
Автор: aidomars
Дата сообщения: 20.09.2011 14:27
А не проще макросом сцепить данные, потом пройтись СЧЁТЕСЛИ и вытащить все что >1 и фсе.
Автор: Quieteroks
Дата сообщения: 20.09.2011 14:35
aidomars
Сцепить Фамилию Имя Отчество и Дату рождения в одну ячейку? И сверять две ячейки?

Потом их нужно будет расцепить. То же самое получится. Только другая задача.
Вроде имеющийся макрос работает отлично. Но странно что два макроса получают разное колличество строк в итоге.
Автор: aidomars
Дата сообщения: 20.09.2011 14:42
Quieteroks
Не надо расцеплять ничего, просто копируем строки где СЧЁТЕСЛИ >1
Автор: asbo
Дата сообщения: 20.09.2011 14:52
Quieteroks

Цитата:
Это уже пляски с бубном.
Проще макросом все обработать.

Потрясающая манера не читать, что написано и оппонировать собственным мыслям из воздуха :) Я уже намекал на это выше.

Я же написал - АЛ-ГО-РИТМ. Вот и писАть по нему макрос. Надо расписать по командам по каждому пункту?

"Пляски с бубном" - устроить такой бордель из данных. С форматированием :) Задача чисто под Акс... А тут - вначале сольем, потом разберемся. Тут играть, тут не играть, тут жирное пятно - рыбу заворачивали... Сливать надо было, ужЕ имея механизм выделения дублей. Вырастили хомячки тыкву в норке :) Да и буфер обмена - потрясное решение для обработки ляма записей. Не работают так с данными. О чем уж говорить, когда дебет с кредитом не сходится? Ты даже проверить не можешь - правильно ли отработали озвученные решения. Бейся дальше ап стену... Хохот душит...
Автор: Quieteroks
Дата сообщения: 20.09.2011 14:56
aidomars
Если не расцепить, дальнешие похождение файла невозможны.
Следующим специалистам нужны все колонки без лишнего.
Макрос можно просто упростить, менее универсальный.
Или упрость с точки зрения скорости.
Автор: asbo
Дата сообщения: 20.09.2011 14:58
aidomars

Цитата:
А не проще макросом сцепить данные, потом пройтись СЧЁТЕСЛИ

На миллионе записей?
Автор: Quieteroks
Дата сообщения: 20.09.2011 16:14
asbo
Ну вообще то единственное форматирование в базе - это выделение другим цветом строк из другой базы. Суть в том, что есть общая база, в которой ищем совпадения с нашей базой. Не знаю зачем, нужны обе строки. Одна из общей, вторая из нашей. Цвет сделан для того, чтоб в дальнейшем определить, чья строчка первая, чья вторая.

Я неделю программирую на VBA. При работе с 12000 записями у нас все получилось отлично. Правда искали уникальные записи. Уж простите что я не в курсе, как в VBA правильнее обработать данные. И стоит ли использовать буфер обмена для этого.

Проверить не могу потому что когда есть две базы, в которых ищу дубли, либо нужно проверь вручную, либо положиться на результат полученый макросом. В одной базе 1000 строк, в другой 500000 строк и как по вашему узнать возможный итог?? Не все 1000 строк имеют дубликат.

Если Вам кажется что Ваш алгоритм возможно будет работает качественно, то у предыдущих двух ребят другой алгоритм и причем работает. И мне очень интересно узнать как он работает, что бы потом можно было пользоваться им.
Автор: asbo
Дата сообщения: 20.09.2011 17:37
Quieteroks
Ну хотя бы сумма записей в уникальных и дублях должна равняться исходной. Мой алгоритм не "качественнее", а просто другой: Исключена работа с буфером обмена. Необратимые изменения производятся один раз и блоками данных, а не поштучно, корпускулами. Включена предварительная сортировка. Для меня его преимущества очевидны. Как и недостатки озвученных решений. Впрочем, главный недостаток неустраним - такие вещи делаются в Аксе. ИСпользование Екселя для несвойственных ему задач порождает вот такие палиативные решения (в т.ч. и мое).
Автор: aidomars
Дата сообщения: 20.09.2011 18:32

Цитата:
Если не расцепить, дальнешие похождение файла невозможны.
Следующим специалистам нужны все колонки без лишнего.

Нужные колонки и не меняются, сцепляем в дополнительном столбце.

Цитата:
На миллионе записей?

Зато 100% заполнение!
Автор: asbo
Дата сообщения: 20.09.2011 19:00
aidomars
Вот ведь, фанаты формульных решений :) Я тоже, бывает, грешу - быстро и сердито ;)
Чем хорош Ексель - практически все можно сваять формулами. Для моделирование - просто восторг! Но, когда начинаются большие данные и систематическая обработка - тут уж увольте...
Автор: aidomars
Дата сообщения: 20.09.2011 19:47
asbo
Я имел ввиду макросом заполнить формулы, дешево и сердито.
Автор: asbo
Дата сообщения: 20.09.2011 19:57
aidomars
А-а... Я недопонял сходу.
Ну а чо? Тоже нормальный костыль :) Не хуже всех выше. Вот, таким образом у Quieteroks получается 4.5 костыля. Собственный, два от AndVGri и SAS888, твой и половинка моего, поскольку лишь алгоритм :)


Автор: AndVGri
Дата сообщения: 21.09.2011 04:05
Quieteroks
Держи с комментариями. Заодно немного подправил (не верна была работа в случае отсутствия дублей).
[more]
Option Explicit

Private Keys As Collection
'Функция получить номер строки перового вхождения
'Аргументы: ключ и номер строки
Private Function FirstEntry(ByVal Key As String, ByVal Index As Long) As Long
On Error GoTo errHandle
Key = UCase$(Key) 'преобразовать (фиг его знает как сравниваются по регистру)
Keys.Add Index, Key 'добавить ключ и номер строки
FirstEntry = -1 'если ключ уникален, то вернуть -1, иначе ошибка
Exit Function
errHandle:
'если ключ не уникален, то вернуть номер строки первого вхождения
FirstEntry = Keys.Item(Key)
End Function
'Выборка уникальных и повторяющихся записей
'Данные должны быть с 1 столбца с первой строки без заголовков
'Алгоритм:
'1 создание столбца с данными уникальности (0 иникальна, >0 - номер строки первого вхождения)
'2 выборка и копирование автофильтром уникальных на новый лист новой рабочей книги
'3 выборка и копирование автофильтром повторяющихся на новый лист созданной рабочей книги
' дополнительно на лист копируется столбец, содержащий номера строк первого вхождения
'4 удаление вспомогательной строки и столбца
Public Sub Test2()
Dim LastCol As Long, i As Long, RowCount As Long, id As Long
Dim heads() As String, arrKey As Variant
Dim Status() As Long, wksSheet As Worksheet
Dim resSheet As Worksheet, resBook As Workbook

Set wksSheet = ActiveSheet 'ссылка на лист данных
Set Keys = New Collection 'создать коллекцию уникальных значений и значений первых вхождений
RowCount = wksSheet.UsedRange.Rows.Count 'определить число строк таблицы данных
'получить данные ключевых столбцов
arrKey = wksSheet.Range(wksSheet.Cells(1, 5), wksSheet.Cells(RowCount, 8)).Value
ReDim Status(1 To RowCount, 1 To 1) 'создать массив определения уникальности

For i = 1 To RowCount 'цикл по данным массива ключевых столбцов
'получить индекс первого вхождения значений ключевых полей
id = FirstEntry(CStr(arrKey(i, 1)) & CStr(arrKey(i, 2)) & CStr(arrKey(i, 3)) & CStr(arrKey(i, 4)), i)
If id > 0 Then 'если такое значение ключевых полей существует
'то пишем номер строки первого вхождения в массив уникальности
Status(i, 1) = id: Status(id, 1) = id
End If
Next i

If Keys.Count < RowCount Then 'если есть повторяющиеся записи
'получить номер последнего столбца + 1 (для вставки данных массива уникальности)
LastCol = wksSheet.UsedRange.Columns.Count + 1
ReDim heads(1 To 1, 1 To LastCol) 'создать массив заголовков столбцов для автофильтра
For i = 1 To LastCol 'заполнить массив заголовков именами стобцов
heads(1, i) = "Cols" & CStr(i)
Next i
'вставить строку для имён столбцов
wksSheet.Rows(1).Insert Shift:=XlInsertShiftDirection.xlShiftDown
'записать имена столбцов в первую строку листа
wksSheet.Range(wksSheet.Cells(1, 1), wksSheet.Cells(1, LastCol)).Value = heads
'записать значения массива уникальности
wksSheet.Range(wksSheet.Cells(2, LastCol), wksSheet.Cells(RowCount + 1, LastCol)).Value = Status
'применить автофильтр для выборки не уникальных значений
wksSheet.UsedRange.AutoFilter LastCol, ">0"
'создать книгу результатов и лист дубликатов
Set resBook = Workbooks.Add()
Set resSheet = resBook.Worksheets.Add()
resSheet.Name = "Дубликаты"
'скопировать отфильтрованные данные
wksSheet.Range(wksSheet.Cells(2, 1), wksSheet.Cells(RowCount + 1, LastCol)).Copy
resSheet.PasteSpecial XlPasteType.xlPasteColumnWidths
resSheet.Paste
'отсортировать записи
resSheet.Sort.SortFields.Clear
id = resSheet.UsedRange.Rows.Count
resSheet.Sort.SortFields.Add resSheet.Range(resSheet.Cells(1, 5), resSheet.Cells(id, 5)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
resSheet.Sort.SortFields.Add resSheet.Range(resSheet.Cells(1, 6), resSheet.Cells(id, 6)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
resSheet.Sort.SortFields.Add resSheet.Range(resSheet.Cells(1, 7), resSheet.Cells(id, 7)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
resSheet.Sort.SortFields.Add resSheet.Range(resSheet.Cells(1, 8), resSheet.Cells(id, 8)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With resSheet.Sort
.SetRange resSheet.UsedRange
.Header = XlYesNoGuess.xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'применить автофильтр для выборки уникальных значений
wksSheet.UsedRange.AutoFilter LastCol, "0"
'создать лист для уникальных значений
Set resSheet = resBook.Worksheets.Add()
resSheet.Name = "Уникальные"
'скопировать отфильтрованные данные
wksSheet.Range(wksSheet.Cells(2, 1), wksSheet.Cells(RowCount + 1, LastCol - 1)).Copy
resSheet.PasteSpecial XlPasteType.xlPasteColumnWidths
resSheet.Paste
'убрать автофильтр
wksSheet.UsedRange.AutoFilter
'удалить вспомогательную строку и столбец
wksSheet.Rows(1).Delete XlDeleteShiftDirection.xlShiftUp
wksSheet.Columns(LastCol).Delete
End If
End Sub
[/more]

asbo

Цитата:
Исключена работа с буфером обмена

Не слишком ли религиозно? Двумя перстами или тремя....
Основное же сказано поздновато

Цитата:
есть две базы, в которых ищу дубли

Вот с этого Quieteroks и надо было начинать. Добавить к таблицами заголовки, задать именованные диапазоны и, например через Microsoft Query, получить в Excel SQL-запросами как совпадающие записи, так и отсутствующие, а не городить огород со слиянием таблиц и последующими танцами с бубном.

Автор: Quieteroks
Дата сообщения: 21.09.2011 07:57
AndVGri


Цитата:
Добавить к таблицами заголовки, задать именованные диапазоны и, например через Microsoft Query, получить в Excel SQL-запросами как совпадающие записи, так и отсутствующие, а не городить огород со слиянием таблиц и последующими танцами с бубном.


В моем случае дают уже одну общую базу.


Всем спасибо. Попробую изъять оригиналы, попробовать Аксом еще раз обработать.
Так зе огромное спасибо за комменты к коду. Буду разбираться.
Автор: asbo
Дата сообщения: 21.09.2011 08:19
AndVGri

Цитата:
Не слишком ли религиозно? Двумя перстами или тремя....
Основное же сказано поздновато

Нисколько. Сугубо меркантильные и материалистические соображения: буфер - нежная и капризная икона. Это раз. А два - вдруг параллельно со мной еще кто-то к этой иконе подойдет помолиться, пока я за свечкой отойду?
Некогда очень было...
Автор: Likseich
Дата сообщения: 21.09.2011 14:11
Братцы, подскажите, пожалуйста, как записать макрос, чтоб он при активации ячейки в заданном диапазоне отображал данные этой акт.ячейки в другой, заданной ячейке.
Нашёл вот это
Код: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 1 Then Cells(1, 2) = Cells(ActiveCell.Row, 1)
End Sub
Автор: asbo
Дата сообщения: 21.09.2011 14:36
Likseich
Вместо Stop - поместить свои процедуры. По уму - так rSrc надо определить на уровне модуля, как минимум, или глобально. Присваивать или по событию открытия книги, или, по активации листа. На множественное выделение не реагирует - только на одну ячейку. Где-то так...

Код: Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rSrc As Range
Set rSrc = Range("B2:C3")
If Target.Cells.Count = 1 Then
If Not Application.Intersect(rSrc, Target) Is Nothing Then
Stop
End If
End If
End Sub
Автор: Likseich
Дата сообщения: 21.09.2011 15:05
Шикарно!
То, что надось...

Добавлю для таких же безграмотных как я.
Если нужны несколько несвязанных диапазонов то пишется

Код: Range("B2:B8, D2:D8, B11:C11")
Автор: asbo
Дата сообщения: 21.09.2011 15:16
Likseich
Вот и славно.
И уточнение про несвязанные диапазоны - совточно.
Автор: steemi
Дата сообщения: 21.09.2011 16:17
помогите разобраться, ругаеться, вот код



Sub s()
Dim mass() As Integer
Dim yach As Integer
Dim znah As Integer
Dim k As Integer
Dim min As Integer
Dim max As Integer
Dim summa As Integer

For i = 1 To 6
yach = "A" + i
znah = Range(yach)
mass(i) = znah
Exit For



max = mass(1)
min = mass(1)
For y = 1 To 6
k = mass(y)
If max < k Then
max = k
End If
If min > k Then
min = k
End If
Exit For
summa = 0
For j = min To max
summa = summa + j
Exit For
MsgBox "сумма = ", , summa
End Sub
Автор: Oyger
Дата сообщения: 21.09.2011 16:24
steemi
Оператор "For" должен оканчиваться "Next", а не "Exit For"
Автор: steemi
Дата сообщения: 21.09.2011 16:27
Вот в это коде:

For i = 1 To 6
yach = "A" + i
znah = Range(yach)
mass(i) = znah
Exit For

как к букву склеить с числом?, он ругаеться, как правильно сделать?
Автор: Oyger
Дата сообщения: 21.09.2011 16:35
steemi
Конечно будет ругаться - у Вас переменная описана как числовая.
Автор: steemi
Дата сообщения: 21.09.2011 16:42
а как мне скрепить строковую и числовую в одну строчку,
так понимаю что число нада перевести в строку, а как?
и можна ли строки склеивать знаком +?
Автор: asbo
Дата сообщения: 21.09.2011 16:47
steemi
Oyger же ответил - везде заменить Exit For на Next!
И на будушее - "ругаеться" никому не интересно и непонятно. Нужен код ошибки.

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127

Предыдущая тема: VS 2010


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.