Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос загрузки данных в SQL
 
Код
Sub ЗагрузитьБалансВнешняяАналитика()
    Лист1.Select
    Call Загрузка_таблицы_на_сервер(False, True)
End Sub


Sub Загрузка_таблицы_на_сервер(Optional trunc As Boolean = False, Optional IsMSSQL As Boolean = True)

With Application: .ScreenUpdating = True: .DisplayAlerts = False: .Calculation = xlCalculationManual: End With

Dim time As Date: time = Now()

Dim a As Long, b As Long, sh_num As Long
Dim fact_list_row As Byte: fact_list_row = 2 'строка с заголовком
Dim format_row As Byte: format_row = 3 'строка с фактом

Dim sql As String, sql_val As String, sql_table As String, fld As String
Dim f_text As String, f_number As Double, f_number_s As String, f_date As Date 'значения
Dim fld_all As String
Dim ASY As Variant, send As Boolean

Dim tbl As String: tbl = ActiveSheet.Name


'создаем соединения
Dim ASY1 As New async, ASY2 As New async, ASY3 As New async, ASY4 As New async, ASY5 As New async, ASY6 As New async, ASY7 As New async, ASY8 As New async
            a = 0
            For Each ASY In Array(ASY1, ASY2, ASY3, ASY4, ASY5, ASY6, ASY7, ASY8)
                a = a + 1
                ASY.Connect
                ASY.ID = a
                While ASY.Connection.State = 2: Wend 'ждем готовности всех соединений
            Next ASY

      tbl = ActiveSheet.Name
        'чистим таблицу на сервере ORACLE
   ' If trunc Then
    '    sql = "truncate table " & tbl & ""
     '   ASY1.Query (sql)
      '  ASY1.ConnectComplete
    'End If
        
        Dim cnt_str As Integer
        cnt_str = ActiveSheet.Cells(2, 1).End(xlToRight).Column
        
        'собираем поля
        fld_all = vbNullString
        For a = 1 To cnt_str
        fld_all = fld_all & ActiveSheet.Cells(2, a) & ","
        Next a
        fld_all = Left(fld_all, Len(fld_all) - 1)
        
        
        Dim c As Long
            For a = 3 To ActiveSheet.Cells(2, 1).End(xlDown).Row
            'If a = 401 Then MsgBox 1
            DoEvents
                sql_val = ""
                                sql_val = ""
                                For b = 1 To 1 + cnt_str
                                        fld = "": fld = ActiveSheet.Cells(2, b).Value
                                        If IsMSSQL Then
                                                Select Case ActiveSheet.Cells(1, b).Value
                                                    Case "t": f_text = ActiveSheet.Cells(a, b).Value:                                   sql_val = sql_val & "'" & f_text & "' " & fld & ","
                                                    Case "n":  f_number_s = Replace(CStr(ActiveSheet.Cells(a, b).Value), "'", ""):  sql_val = sql_val & "cast(replace('" & f_number_s & "',',','.') as float) " & fld & ","
                                                    Case "d": f_date = ActiveSheet.Cells(a, b).Value:                                    sql_val = sql_val & "{ d '" & Format(f_date, "yyyy-mm-dd") & "'} " & fld & ","
                                                End Select
                                            Else 'ORACLE
                                                Select Case ActiveSheet.Cells(1, b).Value
                                                    Case "t": f_text = Replace(ActiveSheet.Cells(a, b).Value, "'", ""):                                 sql_val = sql_val & "'" & f_text & "' " & fld & ","
                                                    Case "n": f_number = ActiveSheet.Cells(a, b).Value: f_number_s = CStr(f_number):    sql_val = sql_val & "cast(replace('" & f_number_s & "',',','.') as float) " & fld & ","
                                                    Case "d": f_date = ActiveSheet.Cells(a, b).Value:                                    sql_val = sql_val & "to_date('" & Format(f_date, "dd.mm.yyyy hh:mm:ss") & "','DD.MM.YYYY HH24:MI:SS') " & fld & ","
                                                End Select
                                        End If
                                Next b
                                    'добавляем юнион
                                    If IsMSSQL Then
                                        sql_val = Left(sql_val, Len(sql_val) - 1) & " " & vbNewLine & " Union all " & vbNewLine
                                        Else 'ORACLE
                                        sql_val = Left(sql_val, Len(sql_val) - 1) & " from dual" & vbNewLine & " Union all " & vbNewLine
                                    End If
                                    
                                    sql_table = sql_table & "Select " & sql_val
                                                                         
                                            'и как мы набрали достаточное кол-во строчек, отправляем данные на сервер
                                                            If a Mod 200 = 0 Then
                                                                If Not sql_table = "" Then
                                                                    sql_table = Left(sql_table, Len(sql_table) - 12)
                                                                    sql = "insert into " & tbl & " (" & fld_all & ") select * from (" & sql_table & ") a"
restart_send:
                                                                        send = False
                                                                                    For Each ASY In Array(ASY1, ASY2, ASY3, ASY4, ASY5, ASY6, ASY7, ASY8)
                                                                                        If ASY.Connection.State = 1 Then
                                                                                            Debug.Print "Запрос отправлен в канал: " & ASY.ID
                                                                                            Application.StatusBar = "Лист: " & 1 & " из " & 1 & ".Строка: " & a & " из " & ActiveSheet.UsedRange.Rows.Count
                                                                                            'Debug.Print sql
                                                                                            ASY.Query sql: send = True: Exit For
                                                                                             
                                                                                                Else
                                                                                                Debug.Print "Канал " & ASY.ID & " занят."
                                                                                        End If
                                                                                    Next ASY
                                                                                If send = False Then
                                                                                    Debug.Print "Все соединения заняты, ожидаю: " & TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 5)
                                                                                    Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
                                                                                    GoTo restart_send
                                                                                End If
                                                                    sql_table = ""
                                                                End If
                                                            End If
               
            Next a
        
        If Not sql_table = "" Then
            sql_table = Left(sql_table, Len(sql_table) - 12)
            sql = "insert into " & tbl & " (" & fld_all & ") select * from (" & sql_table & ") a"
            'MsgBox sql
            ASY1.Query (sql)
            sql_table = ""
            ASY1.ConnectComplete
        End If






With Application: .StatusBar = False: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With
Debug.Print "Загрузка завершена"
End Sub

Класс async
Код
Option Explicit
Public Connection As Object
Public Recordset As Object
Public ID As Long


Private Const MSSQLConnectionString As String = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;User ID=** USER_ID **;Password= ** PASS ** ;Initial Catalog = ** MAIN **;Data Source= ** MY_SERVER **"
'Private Const OracleConnectionString As String = "DSN=OracleODBC;UID=PAU;PWD=DVN7Fxn0;"

Public Sub Create()
Set Me.Connection = CreateObject("ADODB.Connection")
End Sub
Public Sub Destroy()
Set Me.Connection = Nothing
End Sub
Public Sub Connect()
Me.Connection.commandtimeout = 0
Me.Connection.connectiontimeout = 0
Me.Connection.Open MSSQLConnectionString, Options:=16 '!!!!!! Çäåñü íàäî èçìåíèòü ñòðîêó ïîäêëþ÷åíèÿ íà íóæíóþ, ëèáî ïåðåäàòü ïàðàìåòð âûáîðà ñòðîêè â êëàññ
End Sub
Public Sub Disconnect()
Me.Connection.Close
End Sub
Private Sub Class_Initialize()
Call Me.Create
End Sub
Private Sub Class_Terminate()
Dim d As Date: d = Now()

restart_terminate:
If Me.Connection.State <> 1 Then
GoTo restart_terminate
Else
Call Me.Disconnect
End If
Call Me.Destroy
Debug.Print "Íà çàêðûòèå êàíàëà " & Me.ID & " ïîòðà÷åíî: " & Format(Now() - d, "HH:MM:SS")
End Sub

Public Function Query(ByVal QueryString As String) As Date
If Me.Connection Is Nothing Then
Call Me.Create
End If
If Me.Connection.State = 0 Then
Call Me.Connect
End If

While Me.Connection.State <> 1: Wend
Me.Connection.Execute QueryString, 0, 16
End Function

Public Function Query_RS(ByVal QueryString As String) As Date
If Me.Connection Is Nothing Then
Call Me.Create
End If
If Me.Connection.State = 0 Then
Call Me.Connect
End If

Set Me.Recordset = CreateObject("ADODB.recordset")

wait_connection:
If Me.Connection.State <> 1 Then GoTo wait_connection

Me.Recordset.Open QueryString, Me.Connection
End Function


Public Sub ConnectComplete(Optional bool As Boolean = False)
While Me.Connection.State <> 1: Wend
End Sub
нумерация строк с объединенными ячейками, хз как сделать
 
artyrH viktturСпасибо!
Изменено: calve - 25 Мар 2019 14:16:45
нумерация строк с объединенными ячейками, хз как сделать
 
Есть столбец, в котором некоторые ячейки объединены (например 3 и 4 строка - объединены в одну ячейку).
Нужно пронумеровать все ячейки, где объединенная ячейка должна иметь один номер - создать рядом столбец с цифрами по порядку.
Некоторые ячейки исходного столбца могут быть пустыми :(

VBA пжт не предлагать...
Игрушечный пример во вложении.
Изменено: calve - 25 Мар 2019 11:31:44
Заливка строки в зависимости от соотношения значений в двух столбцах
 
удалено
Изменено: calve - 20 Апр 2017 11:11:49 (надо)
Подтянуть значения не по точному соответствию, а по совпадению одного из слов в двух столбцах
 
Сергей , спасибо! Работает.

Вариант Бахтиёр к сожалению не работает :(
Подтянуть значения не по точному соответствию, а по совпадению одного из слов в двух столбцах
 
Есть справочник городов с номерами.
Есть стобец из предложений, в которых находятся города из справочника.
Каким образом массово напротив каждого предложения проставить город из справочника. Города в предложениях написаны точно так же как в справочнике.

Текст по столбцам бить не хочется - некоторые предложения ужасно длинные.
По идее надо как то использовать функцию НАЙТИ()

Файл во вложении.
Изменено: calve - 12 Дек 2016 00:18:56
Обновлять данные в Excel файле из файла, находящегося на сайте и доступного по прямой ссылке, обновление файла из внешнего источника
 
Цитата
JayBhagavan написал: Сделал. Когда удивляться?
у меня видимо слишком новый Excel. Не хочет добавлять :-(
Хотя первая идея была аналогичной.
Обновлять данные в Excel файле из файла, находящегося на сайте и доступного по прямой ссылке, обновление файла из внешнего источника
 
Попробуйте сами так сделать - удивитесь :)
Обновлять данные в Excel файле из файла, находящегося на сайте и доступного по прямой ссылке, обновление файла из внешнего источника
 
Получилось, связав с внешним содержимым простым равенством :)
Изменено: calve - 29 Фев 2016 11:59:51
Обновлять данные в Excel файле из файла, находящегося на сайте и доступного по прямой ссылке, обновление файла из внешнего источника
 
Есть Excel файл, доступный на скачивание по ссылке
http://www.bank.gov.ua/files/UIRD.xls

В нем каждый день обновляются данные.
Есть Excel файл с расчётами, в который каждый день надо в автоматическом режиме импортировать данные.
Подскажите каким образом это можно сделать?
Избушка формулистов-3, не для вопросов, но для формульных задач
 
vikttur, у вас тут всегда принято на ровном месте гнобить новичков?
Я данную задачу решил и она мне показалась очень интересной.
Моё, пусть и не оптимальное решение указано внутри тестового примера.

bedvit перефразирую задачу:
Z зависит от двух переменных X и Y
Нужно найти зависимость X от Y
Изменено: calve - 8 Июн 2015 11:54:57
Избушка формулистов-3, не для вопросов, но для формульных задач
 
Здравствуйте!
Кто не хочет скучать на выходных и хочет подумать!

Дано:
два независящих друг от друга параметра, влияющих на третий через непонятные вычисления.
Необходимо:
построить график зависимости первого параметра от второго, при условии что третий параметр = const

Файлик прилагаю.
Изменено: calve - 8 Июн 2015 12:03:49
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
Ничего из вышеперечисленного не помогло.
Помог google, который подсказал создать кнопку, где на макрос вешается обновление таблицы с параметрами, забираемыми из Excel
Код
Sub buttom()

AI = ActiveSheet.Range("F1")
With ActiveSheet.ListObjects(1)
        .QueryTable.CommandText = "select dfp.valid_from_dt, dfp.contr_term, dfp.FTP_DISB  from dict_ftp_price dfp where dfp.VALID_TILL_DT = Date '4000-01-01' and dfp.contr_term = " & AI
        
  
        .Refresh
    End With

    
End Sub


Пример во вложении. Может кому пригодится :)
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
vikttur а какая кнопка для ответа? :)
Транспортная задача Коммивояжера
 
я бы решил поиском решения разделив на 25 подзадач

Excel 2013 в помощь отметить точки на карте, для выбора пулов точек
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
Сделал файл - пример (в первом посте).
Левая табличка корректно загружается с заранее заданным значением даты, вторая табличка не грузится т.к. дата в ней задаётся динамически.
Создание Графика по 2м столбцам данных., Не помещаются данные !!! Помогите!!!
 
Из Excel достаточно долго придётся всё строить.
Проще загрузить таблицу в MS Access и из него сделать сводную таблицу в Excel по которой строить графики.
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
Выводит аналогичную ошибку.
Тут проблема в том, что SQL понимает код, а Excel не понимает, что нужно выдать запрос.

Я думал, что можно макросом ссылаться на определённые ячейки, в Excel в которых будут находиться даты за которые формируется отчёт.
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
Для доступного понимания сути проблемы я написал скрипт в упрощенном виде.
Реальный скрипт содержит дату в 8 местах, расположенные в различных местах текста.

Занимаюсь автоматизацией ежедневной отчётности - так что каждый день редактировать множество скриптов с датами в куче мест - достаточно сложно.
Формировать отчёты в Excel подключением к SQL, при каждом открытии задавать новый диапазон дат
 
Добрый день!
есть файл Excel, в котором хранится сводная таблица, формируемая SQL запросом типа:
Код
Select * from
sales
where
sales.dt = date'2015-01-01'

Необходимо, чтобы данная сводная таблица формировалась запросом типа:
Код
Select * from
sales
where
sales.dt = date'&D'

При запуске второго скрипта в PL SQL Developer - он запрашивает значение даты и после ввода даты исполняет запрос.
При замене первого запроса вторым в MS Excel - Excel конечно же не запрашивает дату, а просто выдаёт ошибку.

Вопрос:
Каким образом можно передавать дату в подключение для формирования запросов без изменения кода в подключении Excel.

Спасибо! :)
Изменено: calve - 4 Июн 2015 00:07:39
Переписать макросы с VBA для Excel 2007 на OpenOffice, хочу оценить стоимость
 
Добрый день!
необходимо переписать макросы с VBA для Excel 2007 на OpenOffice

Прошу подсказать сколько это может стоить за 1 лист А4 макросов

Примеры задачи выложу в понедельник. Тут вложения не должны превышать 100 Кб
Страницы: 1
Наверх