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

Страницы: 1
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Андрей VG, спасибо, интересное решение, обязательно применю к своей задачи.
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Переделала, поскольку не работал скрипт #2, буду дальше разбирать)
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Нашла ошибку, получается макрос копирует все телефоны, которые относятся к 1 ИНН, а потом со второй строки ставит телефоны другого ИНН.
Нужно организовать цикл так, чтоб телефоны 2 ИНН копировались ниже всех телефонов 1 ИНН.(посчитать кол-во телефонов 1 Инн и потом вставлять значения 2)
Код
For i = 2 To lrINN
    ' Extract the required records.
    rs.Open " SELECT INN, PhoneNumber  from ugph.dbo.v_ClientPhone WHERE INN = '" & Format(Sheets("Телефоны").Cells(i, "D").Value, "General Number") & "' ", cn
    ' Copy the records into cell A1 on Sheet1.
    lrTarget = Cells(Rows.Count, "A").End(xlUp).Row + 1
     ThisWorkbook.Sheets("Телефоны").Cells(i, "A").CopyFromRecordset rs
    ' Tidy up
    rs.Close
Next
Изменено: Yulikolove - 14 Мар 2016 18:59:23
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Спасибо, в SQL-запросе ошибки скорей всего нет, самое интересное выгружаешь телефоны по 1 ИНН-все, только 3 хотя бы запускаешь-вытягивает не все номера)))Загадка))
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Что-то с циклом не так,  вытягивает не все телефоны, работает в таком виде-файл прилагаю.
Жёлтым выделила, что должно выгрузится, вообщем цикл скорей всего урезает телефоны.
Изменено: Yulikolove - 14 Мар 2016 17:04:32
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Karataev, огромнейшее человеческое СПАСИБИЩЕ!!!! Я код немного исправлю, потому что он не выводил значения. Сброшу работающий)))))))))))))) :D
...сколько человеку для счастья то надо))))))))
Изменено: Yulikolove - 14 Мар 2016 10:55:18
VBA. Динамический список переменных передать в SQL
 
Добрый вечер, а можно без цикла обойтись в таком примере:
.Open " SELECT INN, PhoneNumber  from ugph.dbo.v_ClientPhone WHERE INN = '" & Format(Sheets("Телефоны").Range("d2").Value, "General Number") & "' ", cn

мне нужно вместо "d2" взять весь столбец [d:d]
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
Добрый день! Написала макрос, который по заданному ИНН (вводим его в ячейку d2) вытягивает все существующие телефоны из базы данных. Не получается переписать код. дабы макрос тянул не один ИНН а наприм по 10000 заданным вытягивал все возможные телефоны. Буду благодарна за помощь.
VBA транспортировать значение по условию.
 
Добрый день, очень нужен запрос наоборот. Есть данные в столбец, нужно транспонировать в строку.
Исходные данные, выделенные жёлтым, нужно сделать в формате, выделенным голубым.
Прилагаю макрос, который быстро работает на больших массивах(преобразует строку в столбец, мне нужен обратный)
Спасибо большое!!!

Код
Sub Trans()
    Dim rngHor As Range
    Dim rngVer As Range
    Dim rngOut As Range
    Dim counter As Long
    Dim lngRow As Long
    Dim cell As Range
  
    Set rngHor = Application.InputBox("Enter Data range", Type:=8)
    Set rngVer = Application.InputBox("Enter Vertical range", Type:=8)
    Set rngOut = Application.InputBox("Enter Output range", Type:=8)
  
    For Each cell In rngVer
        DoEvents
        rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell
        rngOut(counter + 1, 2).Resize(rngHor.Columns.Count, 1).Value2 = WorksheetFunction.Transpose(rngHor.Rows(lngRow + 1))
        lngRow = lngRow + 1
        counter = counter + rngHor.Columns.Count
    Next
     
    Const lCol As Long = 2 'Номер слобца,где ищем пустые ячейки
    Const lFirstRow As Long = 1 'Номер строки с которой начинаем отчёт
    Dim li As Long, lLastRow As Long, lCalc As Long
        With Application
        'Для ускорения выполнения Отключаем обновление экрна и пересчет формул
        .ScreenUpdating = 0: lCalc = .Calculation: .Calculation = xlManual 'идем циклом по всем ячейкам столбца lCol
            For li = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To lFirstRow Step -1
                 'Если ячейка пустая - удаляем строку.
                 If Cells(li, lCol) = "" Then Rows(li).Delete
            Next li
    'возвращаем обновление экрна и пересчет формул
     .ScreenUpdating = 1: .Calculation = lCalc
      End With
End Sub
Макрос для транспонирования, Сложное транспонирование
 
Добрый день, очень нужен запрос наоборот. Есть данные в столбец, нужно транспонировать в строку.
Исходные данные, выделенные жёлтым, нужно сделать в формате, выделенным голубым.
Прилагаю
Код
Sub Trans()
    Dim rngHor As Range
    Dim rngVer As Range
    Dim rngOut As Range
    Dim counter As Long
    Dim lngRow As Long
    Dim cell As Range
 
    Set rngHor = Application.InputBox("Enter Data range", Type:=8)
    Set rngVer = Application.InputBox("Enter Vertical range", Type:=8)
    Set rngOut = Application.InputBox("Enter Output range", Type:=8)
 
    For Each cell In rngVer
        DoEvents
        rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell
        rngOut(counter + 1, 2).Resize(rngHor.Columns.Count, 1).Value2 = WorksheetFunction.Transpose(rngHor.Rows(lngRow + 1))
        lngRow = lngRow + 1
        counter = counter + rngHor.Columns.Count
    Next
    
    Const lCol As Long = 2 'Номер слобца,где ищем пустые ячейки
    Const lFirstRow As Long = 1 'Номер строки с которой начинаем отчёт
    Dim li As Long, lLastRow As Long, lCalc As Long
        With Application
        'Для ускорения выполнения Отключаем обновление экрна и пересчет формул
        .ScreenUpdating = 0: lCalc = .Calculation: .Calculation = xlManual 'идем циклом по всем ячейкам столбца lCol
            For li = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To lFirstRow Step -1
                 'Если ячейка пустая - удаляем строку.
                 If Cells(li, lCol) = "" Then Rows(li).Delete
            Next li
    'возвращаем обновление экрна и пересчет формул
     .ScreenUpdating = 1: .Calculation = lCalc
      End With
End Sub
макрос, который быстро работает на больших массивах(преобразует строку в столбец, мне нужен обратный)
Спасибо большое!!!
Копирование значений ячеек с формированием
 
Добрый день, уважаемые Пользователи. Нужна помощь.
У меня есть Excel файл, в котором 2 колонки. В первой-находятся Объекты, во 2 описание их.
Мне нужны все объекты, которые находятся в оренде.

Вот в таком виде:
1.  Земельный участок, общая площадь 0.699 га по адресу Одесская обл., г. Одесса, улица
Новощепной ряд, дом 5, 5110137500:33:003:0008
2.  Земельный участок, общая площадь 1.9808 га по адресу по адресу Одесская обл., г.Одесса, Люстдорфская дорога, дом 90,  5110136900:09:005:0021

Прилагаю файл, в каком виде данные выгружаются, при том бывают ситуации, когда между двумя записями есть объекты, которые не в оренде, а в собственности.
Меню для Надстройки в Excel 2011, Как создать?
 
Доброго дня всем! Есть функция Супер Впр.
Я сделала надстройку. Хочу спросить, когда в ячейки Excel пишу = VLOOKUP2(подсказки никакой нет) так и должно быть?
Искомая ячейка, Искомый интервал, Интервал...
Код
Public Function VLOOKUP2(table As Range, SearchColumnNum As Integer, SearchValue As Variant, _
                                        N As Integer, ResultColumnNum As Integer)
    Dim i As Integer
    Dim iCount As Integer
          
    For i = 1 To table.Rows.Count
            If table.Cells(i, SearchColumnNum) = SearchValue Then
                iCount = iCount + 1
            End If
            If iCount = N Then
                VLOOKUP2 = table.Cells(i, ResultColumnNum)
                Exit For
            End If
        Next i
End Function


Public Function VLOOKUP3(table As Range, SearchColumnNum As Integer, SearchValue As Variant, _
                                         ResultColumnNum As Integer)
        Dim x As Integer
        Dim i As Integer
        Dim qwe As Variant
        x = Application.WorksheetFunction.CountIf(table, SearchValue)
        qwe = ""
        If x = 0 Then
            VLOOKUP3 = ""
            Exit Function
        End If
        
        For i = 1 To x
         qwe = qwe & i & ")" & VLOOKUP2(table, SearchColumnNum, SearchValue, i, ResultColumnNum) & "   "
        Next i
        
        VLOOKUP3 = qwe
            
End Function
VBA транспортировать значение по условию.
 
Спасибо.
VBA транспортировать значение по условию.
 
Доброе утро!Юрий. Как  я читала,чтоб не обновлялись формулы...вроде.
Работал у меня этот скрипт,никаких багов не было. Теперь выдаёт "Runtime error 1004: application-defined or object-defined error".
В этой строке rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell.
С типом значений связано.
Почему так получается,ведь до этого работал.
И как убрать эту ошибку?
VBA транспортировать значение по условию.
 
Добрый день, я уже сама от своего макроса устала)))
Добавила я 3 столбец. Эксель матерится))
Смогла сама переделать-росту!
Код
Sub Сцеплять()
    For r = ActiveCell.Row To ActiveCell.End(xlDown).Row
    Cells(r, 1) = "'(" & Cells(r, 1) & "," & Cells(r, 2) & "," & Cells(r, 3) & ")"
    Range(Cells(r, 3), Cells(r, 3)).ClearContents
    Application.DisplayAlerts = False
    Range(Cells(r, 1), Cells(r, 3)).Merge
    Application.DisplayAlerts = True
  Next
End Sub
Изменено: Yulikolove - 11 Сен 2015 12:56:29
VBA транспортировать значение по условию.
 
Спасибо! Работает.
Один знак-всё меняет! :D
VBA транспортировать значение по условию.
 
Не совсем, макрос работает, но игнорирует запятую.
Скобки в начале и в конце проставляются. А вот запятая между сцепленными данными нет.
Сброшу макрос.
Может запятую как-то по-другому выделять нужно?
Код
Sub Слеить_сцепить()
  For r = ActiveCell.Row To ActiveCell.End(xlDown).Row
    Cells(r, 1) = "(" & Cells(r, 1) & "," & Cells(r, 2) & ")"
    Range(Cells(r, 2), Cells(r, 2)).ClearContents
    Range(Cells(r, 1), Cells(r, 2)).Merge
  Next
End Sub
VBA транспортировать значение по условию.
 
Код
Sub Trans() 
Dim rngHor As Range 
Dim rngVer As Range 
Dim rngOut As Range 
Dim counter As Long 
Dim lngRow As Long 
Dim cell As Range 

Set rngHor = Application.InputBox("Enter Data range", Type:=8) 
Set rngVer = Application.InputBox("Enter Vertical range", Type:=8) 
Set rngOut = Application.InputBox("Enter Output range", Type:=8) 

For Each cell In rngVer 
DoEvents 
rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell 
rngOut(counter + 1, 2).Resize(rngHor.Columns.Count, 1).Value2 = WorksheetFunction.Transpose(rngHor.Rows(lngRow + 1)) 
lngRow = lngRow + 1 
counter = counter + rngHor.Columns.Count 
Next 

Const lCol As Long = 2 'Номер слобца,где ищем пустые ячейки 
Const lFirstRow As Long = 1 'Номер строки с которой начинаем отчёт 
Dim li As Long, lLastRow As Long, lCalc As Long 
With Application 
'Для ускорения выполнения Отключаем обновление экрна и пересчет формул 
.ScreenUpdating = 0: lCalc = .Calculation: .Calculation = xlManual 'идем циклом по всем ячейкам столбца lCol 
For li = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To lFirstRow Step -1 
'Если ячейка пустая - удаляем строку. 
If Cells(li, lCol) = "" Then Rows(li).Delete 
Next li 
'возвращаем обновление экрна и пересчет формул 
.ScreenUpdating = 1: .Calculation = lCalc 
End With 
End Sub

Сори, я не очень внимательная :oops:
VBA транспортировать значение по условию.
 
Прилагаю файл
VBA транспортировать значение по условию.
 
Во!))
Код
Sub Trans()
    Dim rngHor As Range
    Dim rngVer As Range
    Dim rngOut As Range
    Dim counter As Long
    Dim lngRow As Long
    Dim cell As Range
 
    Set rngHor = Application.InputBox("Enter Data range", Type:=8)
    Set rngVer = Application.InputBox("Enter Vertical range", Type:=8)
    Set rngOut = Application.InputBox("Enter Output range", Type:=8)
 
    For Each cell In rngVer
        DoEvents
        rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell
        rngOut(counter + 1, 2).Resize(rngHor.Columns.Count, 1).Value2 = WorksheetFunction.Transpose(rngHor.Rows(lngRow + 1))
        lngRow = lngRow + 1
        counter = counter + rngHor.Columns.Count
    Next
    
Const lCol As Long = 2 'Номер слобца,где ищем пустые ячейки
Const lFirstRow As Long = 1 'Номер строки с которой начинаем отчёт
Dim li As Long, lLastRow As Long, lCalc As Long
With Application
'Для ускорения выполнения Отключаем обновление экрна и пересчет формул
.ScreenUpdating = 0: lCalc = .Calculation: .Calculation = xlManual 'идем циклом по всем ячейкам столбца lCol
For li = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1 To lFirstRow Step -1
'Если ячейка пустая - удаляем строку.
If Cells(li, lCol) = "" Then Rows(li).Delete
Next li
'возвращаем обновление экрна и пересчет формул
.ScreenUpdating = 1: .Calculation = lCalc
End With
End Sub
VBA транспортировать значение по условию.
 
Если бы я понимала VBA))))) А почему по ИНН? По телефонам,наверное. Нужно проверить,где нет телефонов-строку удаляем полностью. И верхушку нужно переделать. Попробую сама конечно.
VBA транспортировать значение по условию.
 
Прилагаю файл,если у кого-то будет возможно свободное время.
Прохожу испытательный срок-каждый день что-то новое.
Заранее благодарна.
Изменено: Yulikolove - 9 Сен 2015 11:36:31
VBA транспортировать значение по условию.
 
Спасибо, вчера нужно было работать с макросом, разобрала)))
Попробую на выходных оптимизировать, чтоб не было пустых ячеек и подпись была одна Inn, Phone.
Если до выходных кто-то сможет помочь-буду благодарна.
Спасибо, Вам, ещё раз.
VBA транспортировать значение по условию.
 
Первый вариант понятен полностью, во втором не пойму,что нужно вводить в окошко "Enter Data range" - ?
"Enter Vertical range" -  выделяю длину данных по вертикале,
"Enter Output range"  - длину данных по горизонтали
VBA транспортировать значение по условию.
 
Спасибо огромное,Вам!!!Буду разбирать сейчас.  :D
VBA транспортировать значение по условию.
 
Сбрасываю файл в Excel
VBA транспортировать значение по условию.
 
Добрый день, я аналитик SQl c VBA ещё не сталкивалась,прошу помощь. Нужен макрос,при том кол-во данных по вертикале и горизонтале не известен. Задача похожа на 1, которая представлена выше. У меня есть Желаемый результат,нужно получить Таблицу. Тоже без дубликатов.
Скрытый текст
Страницы: 1
Наверх