Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Оптимизировать макрос для Виндус под Мак
 
Добрый день!
Имеется макрос в Эксель, работающий на виндус. Макрос открывает окно для выбора файлов, далее открывает по очереди выбранные файлы и собирает из них данные из определенных столбцов. Далее по полученным данным формируется сводная (SQL запросом). Код не сложный и не объемный, выкладываю ниже. Нужно оптимизировать, что бы данный макрос работал на Маке.

Если часть запроса, где подключается библиотека для SQL запроса сложно реализовать на Маке, то можно без него, я заменю на стандартную сводную в Эксель, главное, что бы данные собирались из других файлов во вкладку "Временная таблица".

Бюджет 500 р. Файл вышлю на почту исполнителю.
Код
Application.ScreenUpdating = False
nm = ActiveWorkbook.Name
 
Range(Worksheets("Сводная").Cells(2, 1), Worksheets("Сводная").Cells(1048576, 4)).ClearContents
Range(Worksheets("Временная таблица").Cells(2, 1), Worksheets("Временная таблица").Cells(1048576, 4)).Clear


Dim avFiles
'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
avFiles = Application.GetOpenFilename _
        ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , True)
If VarType(avFiles) = vbBoolean Then
    'была нажата кнопка отмены - выход из процедуры
    Exit Sub
End If
    'avFiles - примет тип String
For Each x In avFiles
    Workbooks.Open x
    nm2 = ActiveWorkbook.Name
    n = Cells(Rows.Count, 17).End(xlUp).Row
    n2 = Workbooks(nm).Worksheets("Временная таблица").Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 5 To n
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 1) = Cells(i, 17)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 2) = Cells(i, 18)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 3) = Cells(i, 19)
        Workbooks(nm).Worksheets("Временная таблица").Cells(n2, 4) = Cells(i, 25)
        n2 = n2 + 1
    Next i
    Workbooks(nm2).Close
Next





'Подключаем библиотеку SQL
Dim CON As Object 'New ADODB.Connection
Dim RS As Object 'New ADODB.Recordset
Dim arrS

Set CON = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")

CON.Provider = "Microsoft.ACE.OLEDB.12.0"
CON.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & "; Extended Properties=""Excel 12.0 Xml;HDR=YES"""
CON.Open

'Заполняем шаблон
RS.Open "SELECT ИНН, КПП, Наименование, SUM(Сумма) FROM [Временная таблица$] GROUP BY ИНН, КПП, Наименование", CON
If RS.EOF Then
    RS.Close
Else
    Worksheets("Сводная").Range("A2").CopyFromRecordset RS
    RS.Close
End If

Application.ScreenUpdating = True
MsgBox "Готово"



 
Изменено: DopplerEffect - 8 Апр 2019 08:07:04
 
Пока нашел исполнителя сам, вопрос снимается до выяснения.
Страницы: 1
Читают тему (гостей: 1)
Наверх