данных достаточно для прогнозов...
Спасибо |
---|
Mail: В профиле Skype: В профиле |
21.07.2011 00:25:26
Public Function ADO_R_Dmitry(ByVal strSql$, ByVal FilePath$, ByVal OutputRange As Range, _
ByVal FieldsName As Boolean, ByVal OutputFieldsName As Boolean) '=========================================================== '*Описание функции : Возвращает набор записей Recordset с первой ячейки адреса, '* указанного диапазона. '*strSql - Конструкция SQL запроса. '* FilePath - Полный путь к файлу включая имя и расширение. '* OutputRange - адрес ячеки с которой начинается вывод данных. '* FieldsName - используются или нет заголовки столбцов (True - False) '* OutputFieldsName - вывод данных с заголовками или без (True - False), _ '* если FieldsName=False, заголовки не выводятся. '=========================================================== '* Автор R Dmitry (Дмитрий Русак dg_rusak@mail.ru skype: RDG_Dmitry) | '* WM:_R269866874234 U144446690328 | '=========================================================== Dim sCon As String, FieldName As String Dim rs As Object, cn As Object Set rs = CreateObject("ADODB.Recordset") Set cn = CreateObject("ADODB.Connection") If FieldsName Then FieldName = "Yes" Else FieldName = "No" Select Case CLng(Split(Application.Version, ".")(0)) Case Is < 12 sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _ & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";" Case Is >= 12 sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _ & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";" End Select cn.Open sCon If Not cn.State = 1 Then Exit Function Set rs = cn.Execute(strSql) If Not FieldsName Then OutputFieldsName = False If OutputFieldsName Then For i = 0 To rs.Fields.Count - 1 OutputRange.Offset(0, i) = rs.Fields(i).Name Next Set OutputRange = OutputRange.Offset(1, 0) End If OutputRange.CopyFromRecordset rs rs.Close: cn.Close Set cn = Nothing: Set rs = Nothing End Function Комментарии и пожелания приветствуются :) пример использования в файле
|
|||
|
18.07.2011 21:39:37
Не так давно промелькнула тема, про фамилию и инициалы, с не совсем стандартными фамилиями и приставками типа Оглы :)и было там красивое решение не помню уже чье :(
Полдня сегодня искал по форуму не смог найти, может во время июньского сбоя куда нибудь канула... :( Если ткнете меня носом буду очень благодарен. С уважением Дмитрий.
|
|||
|
22.12.2010 00:08:06
Знаю что контрол специфический :) но, что делать..
мне необходимо программно изменять заливку диапазона ячеек на время удержания мышом labela,ничего лучшего не нашел, как использовать такой способ: Private Sub Надпись116_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) With MSFlexGrid2 .row = 1 .col = 3 .CellBackColor = 10092390 .col = 4 .CellBackColor = 10092390 End With End Sub Private Sub Надпись116_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With MSFlexGrid2 .row = 1 .col = 3 .CellBackColor = 0 .col = 4 .CellBackColor = 0 End With End Sub Может кто сталкивался с ним , подскажет как обратиться к диапазону ячеек MSFlexGrid ?
|
|||
|
02.11.2010 20:44:15
В одной случае не работает, во втором работает почему ?
Sub test1()'Не работает Dim rng As Range, rng1 As Range, rng2 As Range, arr, i& ReDim arr(2) For i = 0 To 2 Set rng = Range("A" & 1 + i & ":C" & i + 1) arr(i) = rng Next i arr(2).Interior.Color = 65535 End Sub Sub test2()'Работает Dim rng As Range, rng1 As Range, rng2 As Range, arr, i& Set rng = Range("A1:C1") Set rng1 = Range("A2:C2") Set rng2 = Range("A3:C3") arr = Array(rng, rng1, rng2) arr(2).Interior.Color = 65535 End Sub *22757*
|
|||
|
26.09.2010 11:57:10
этот макрос нормально отрабатывает с Range , а как то же самое сделать с одномерным массивом без цикла
Sub findRange() Dim iRange As Range Dim iFind As String iFind = "123456" arr = Range("A:A").Value 'Set iRange = arr.Find(what:=iFind, LookAt:=xlWhole) 'с Range все нормально отрабатывает, а как то же самое сделать с одномерным массивом _ без цикла Set iRange = Range("A:A").Find(what:=iFind, LookAt:=xlWhole) If iRange Is Nothing Then MsgBox "Значения нет" Else MsgBox "Значеие есть" End If End Sub
|
|||
|
08.09.2010 01:13:37
Есть Гант через условное форматирование с возможностью выбора года и месяца
"подотчетные лица" подтягиваются через vba путем копирования уникальных значений вопрос ..... как отобрать уникальные значения "подотчетные лиц" в выбранном периоде формат 2007 (по формулам)45кь 77377 Вау!
|
|||
|
20.08.2010 00:31:01
вопрос в следующем
1.есть справочник должностей который заполняется и редактируется через форму 2. при формировании на листе stat_rasp штатного расписания по двойному клику вызывается форма справочника и двойным кликом по листбоксу формируется примерно такая формула =ДВССЫЛ("spr_dolgnostey!B"&ПОИСКПОЗ(71;spr_id;0)+1)которая идентифицирует эту должность так как на листе spr_dolgnostey происходит сортировка данных по названию после добавления или изменения должности то простая ссылка не годится, условия заказчика при изменении должности в справочнике она должна поменяться во всех листах их порядка 20 и таких формул на листе получается порядка 50-150 так как двссыл() летучий голандец файл притормаживает Посоветуйте что можно придумать?
|
|||
|
11.07.2010 23:31:03
есть такой код
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Dim a As String If KeyAscii > 31 Then a = Chr(KeyAscii) new_klient = new_klient & a 'new_klient глобальная переменная End If End Sub записывает введенный текст в глобальную переменную если пользователь удаляет символ любым способом как это отразить в глобальной переменной мне нужно событие именно KeyPress!!!! скажу сразу пример в access поэтому надо именно KeyPress!!!! даю пример в excel
|
|||
|
23.06.2010 22:34:58
Добрый вечер! вопрос без примера!
Есть БД access формата mdb? Доступ организован через учетные записи пользователей, клиент тоже access, 1.Как получить доступ к чтению БД в excel используя пользовательскую учетную запись access? суть проблемы: Я могу свободно подключаться к БД используя учетную запись по умолчанию - admin, без пароля, если я ввожу имя пользователя и пароль выскакивает еще одна "зараза" скрин прилагается, нажимаю ок -- все пропадает графа "строка доступа" не знаю что это? может кто подскажет чего 64 кб
|
|||
|
07.06.2010 00:31:39
Подскажите нашел такую програмину "Protect VBA" от eliansoft по защите кода от взлома,
может есть мнения и отзывы пробовал елкомсофтом -- неберет, пробовал vba masters тож неберет понравилась что эти две программы не берут так как самые распространенные не понравилась - нельзя опять открыть код для правки, только исправить в незащищенном файле и снова перекодировать. насколько надежна?
|
|||
|
18.05.2010 01:14:08
Dim r As Integer, y, z As Double
For r = 0 To ListBox1.ListCount - 1 y = y + Val(ListBox1.List(r, 6)) z = z + Val(ListBox1.List(r, 7)) Next r этот код дает сумму 6 и 7 столбца в листбоксе но если в лист боксе стоит формат ListBox1.List(A, 6) = Format(.Cells(j, 7).Value, "#,##0") то он считает только последние цифры до разделителя разрядов Вопрос можно ли с этим бороться и если можно то как?
|
|||
|
27.04.2010 00:22:46
Подскажите есть форма которая закрывается кнопкой CommandButton
при нажатии на кнопку также очищаются некоторые значения на листе екселя. Если нажать в правом верхнем углу на крестик , форма закроется а событие не произойдет Собственно вопрос ---- как этого избежать? можно ли убрать этот крестик? можно ли этому крестику назначить событие?
|
|||
|
04.03.2010 20:26:14
подскажите пожалуйста как получить значение в ячейке, допустим число 0,55 используя макрос
вводя данные с русской раскладки клавиатуры, то есть с английской вводится все нормально 0.55 а с русской 0,55 и значение выдает 0. пока использую соседнюю ячейку в листе и формулу =ЗНАЧЕН(A1) а с макроса убираю Val Sub ddd() Range("A1") = Val(InputBox("")) End Sub
|
|||
|
20.02.2010 12:26:46
Sub copi_A()
ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=2, Criteria1:= _ "шт" Range("B8:D18").Select 'Подправить необходимо верхнюю строку что бы выбирался не заданный диапазон ячеек а отфильтрованная таблица' Selection.Copy Sheets("Лист2").Select Range("B8").Select ActiveSheet.Paste Sheets("Лист1").Select ActiveSheet.ListObjects("Таблица1").Range.AutoFilter Field:=2 End Sub Помогите подправить
|
|||
|