Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Yulikolove
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
15.03.2016 15:07:40
Андрей VG, спасибо, интересное решение, обязательно применю к своей задачи.
 
Перейти    
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
15.03.2016 10:18:24
Переделала, поскольку не работал скрипт #2, буду дальше разбирать)
 
Перейти    
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
14.03.2016 18:58:43
Нашла ошибку, получается макрос копирует все телефоны, которые относятся к 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.03.2016 18:59:23
 
Перейти    
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
14.03.2016 17:18:49
Спасибо, в SQL-запросе ошибки скорей всего нет, самое интересное выгружаешь телефоны по 1 ИНН-все, только 3 хотя бы запускаешь-вытягивает не все номера)))Загадка))
 
Перейти    
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
14.03.2016 13:26:25
Что-то с циклом не так,  вытягивает не все телефоны, работает в таком виде-файл прилагаю.
Жёлтым выделила, что должно выгрузится, вообщем цикл скорей всего урезает телефоны.
Изменено: Yulikolove - 14.03.2016 17:04:32
 
Перейти    
По заданному столбцу выгрузить данные из SQL, экспорт данных из Excel в SQl
 
#
14.03.2016 10:19:03
Karataev, огромнейшее человеческое СПАСИБИЩЕ!!!! Я код немного исправлю, потому что он не выводил значения. Сброшу работающий)))))))))))))) :D
...сколько человеку для счастья то надо))))))))
Изменено: Yulikolove - 14.03.2016 10:55:18
 
Перейти    
VBA. Динамический список переменных передать в SQL
 
#
12.03.2016 18:07:13
Добрый вечер, а можно без цикла обойтись в таком примере:
.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
 
#
12.03.2016 15:54:45
Добрый день! Написала макрос, который по заданному ИНН (вводим его в ячейку d2) вытягивает все существующие телефоны из базы данных. Не получается переписать код. дабы макрос тянул не один ИНН а наприм по 10000 заданным вытягивал все возможные телефоны. Буду благодарна за помощь.
 
Перейти    
VBA транспортировать значение по условию.
 
#
18.01.2016 12:01:17
Добрый день, очень нужен запрос наоборот. Есть данные в столбец, нужно транспонировать в строку.
Исходные данные, выделенные жёлтым, нужно сделать в формате, выделенным голубым.
Прилагаю макрос, который быстро работает на больших массивах(преобразует строку в столбец, мне нужен обратный)
Спасибо большое!!!

Код
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
 
Перейти    
Макрос для транспонирования, Сложное транспонирование
 
#
18.01.2016 11:14:17
Добрый день, очень нужен запрос наоборот. Есть данные в столбец, нужно транспонировать в строку.
Исходные данные, выделенные жёлтым, нужно сделать в формате, выделенным голубым.
Прилагаю
Код
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
макрос, который быстро работает на больших массивах(преобразует строку в столбец, мне нужен обратный)
Спасибо большое!!!
 
Перейти    
Копирование значений ячеек с формированием
 
#
13.11.2015 13:15:07
Добрый день, уважаемые Пользователи. Нужна помощь.
У меня есть Excel файл, в котором 2 колонки. В первой-находятся Объекты, во 2 описание их.
Мне нужны все объекты, которые находятся в оренде.

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

Прилагаю файл, в каком виде данные выгружаются, при том бывают ситуации, когда между двумя записями есть объекты, которые не в оренде, а в собственности.
 
Перейти    
Меню для Надстройки в Excel 2011, Как создать?
 
#
18.09.2015 17:48:05
Доброго дня всем! Есть функция Супер Впр.
Я сделала надстройку. Хочу спросить, когда в ячейки 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 транспортировать значение по условию.
 
#
15.09.2015 14:48:07
Спасибо.
 
Перейти    
VBA транспортировать значение по условию.
 
#
14.09.2015 10:28:43
Доброе утро!Юрий. Как  я читала,чтоб не обновлялись формулы...вроде.
Работал у меня этот скрипт,никаких багов не было. Теперь выдаёт "Runtime error 1004: application-defined or object-defined error".
В этой строке rngOut(counter + 1, 1).Resize(rngHor.Columns.Count, 1).Value2 = cell.
С типом значений связано.
Почему так получается,ведь до этого работал.
И как убрать эту ошибку?
 
Перейти    
VBA транспортировать значение по условию.
 
#
11.09.2015 11:23:40
Добрый день, я уже сама от своего макроса устала)))
Добавила я 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.09.2015 12:56:29
 
Перейти    
VBA транспортировать значение по условию.
 
#
10.09.2015 16:17:45
Спасибо! Работает.
Один знак-всё меняет! :D
 
Перейти    
VBA транспортировать значение по условию.
 
#
10.09.2015 14:54:59
Не совсем, макрос работает, но игнорирует запятую.
Скобки в начале и в конце проставляются. А вот запятая между сцепленными данными нет.
Сброшу макрос.
Может запятую как-то по-другому выделять нужно?
Код
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 транспортировать значение по условию.
 
#
10.09.2015 09:54:48
Код
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 транспортировать значение по условию.
 
#
09.09.2015 17:44:45
Прилагаю файл
 
Перейти    
VBA транспортировать значение по условию.
 
#
09.09.2015 15:00:27
Во!))
Код
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 транспортировать значение по условию.
 
#
09.09.2015 12:46:27
Если бы я понимала VBA))))) А почему по ИНН? По телефонам,наверное. Нужно проверить,где нет телефонов-строку удаляем полностью. И верхушку нужно переделать. Попробую сама конечно.
 
Перейти    
VBA транспортировать значение по условию.
 
#
09.09.2015 11:05:07
Прилагаю файл,если у кого-то будет возможно свободное время.
Прохожу испытательный срок-каждый день что-то новое.
Заранее благодарна.
Изменено: Yulikolove - 09.09.2015 11:36:31
 
Перейти    
VBA транспортировать значение по условию.
 
#
09.09.2015 10:56:32
Спасибо, вчера нужно было работать с макросом, разобрала)))
Попробую на выходных оптимизировать, чтоб не было пустых ячеек и подпись была одна Inn, Phone.
Если до выходных кто-то сможет помочь-буду благодарна.
Спасибо, Вам, ещё раз.
 
Перейти    
VBA транспортировать значение по условию.
 
#
08.09.2015 09:25:23
Первый вариант понятен полностью, во втором не пойму,что нужно вводить в окошко "Enter Data range" - ?
"Enter Vertical range" -  выделяю длину данных по вертикале,
"Enter Output range"  - длину данных по горизонтали
 
Перейти    
VBA транспортировать значение по условию.
 
#
07.09.2015 22:32:13
Спасибо огромное,Вам!!!Буду разбирать сейчас.  :D
 
Перейти    
VBA транспортировать значение по условию.
 
#
07.09.2015 17:23:55
Сбрасываю файл в Excel
 
Перейти    
VBA транспортировать значение по условию.
 
#
07.09.2015 16:22:59
Добрый день, я аналитик SQl c VBA ещё не сталкивалась,прошу помощь. Нужен макрос,при том кол-во данных по вертикале и горизонтале не известен. Задача похожа на 1, которая представлена выше. У меня есть Желаемый результат,нужно получить Таблицу. Тоже без дубликатов.
Скрытый текст
 
Перейти    
Страницы: 1
Наверх