» Excel VBA (часть 3)

Offset(0, 4).Value - в этой ячейке нет #знач?

NJCorp, не проще записать
Код: Zapovn rg.Offset(, 4)

Цитата:

Offset(0, 4).Value - в этой ячейке нет #знач?

нет конечно
vlth
изначально так и било, меня интересует ошибка а не модернизация кода
функция Zapovn () самостоятельно работает, и цикл нормально работает, если не запускать в теле функция (пробовал на msgbox .... все как часики). А вот вместе....
я уже и другой цикл пробовал (for to next) - один фиг, придется переделивать...

Цитата:

Народ, помогите... достал меня етот кусочек кода...
Вибрасивает ерор91, немогу понять что не туда...

Err.Number=91:
Цитата:

Объектная переменная или переменная блока With не установлена. Эта ошибка возникает, если не пользоваться оператором Set в начале создания объектной переменной. Кроме того, такая ошибка возникает, когда создаётся ссылка на объект рабочего листа (например, ActiveCell), а в это время активен лист диаграммы.

Цитата:

... меня интересует ошибка а не модернизация кода

NJCorp, Вы можете, не "модернизировав" свой код и не заглядывая в VBE, утверждать, ссылки на все объекты у Вас создаются корректно?
Я - нет. Поэтому код и переписан.

Ошибки, по крайней мере, в синтаксисе, в переделанном варианте нет.
Ищите источник ошибки при пошаговом выполнении процедуры.

З.Ы. Предполагаете, что компилятор пропустит ошибку, если её таким образом замаскировать?

Может, кто знает, как в макросе сделать ссылку на "динамический" диапазон строк/столбцов, аналогично такому выделению "динамического" диапазона ячеек с помощью комбинации формул ДВССЫЛ и АДРЕС. Т.е. чем можно заменить цифры в диапазоне вида
Rows("4:10)".Select.
так, чтобы это было приемлемо для работы макроса.
Попытки вставить в эту строку названные выше функции в разных комбинациях, абсолютный и относительный адреса ячейки с вычисленным номером строки ничего не дали, макрос сбоит и ругается.
Использование
i = 4: j = 10
Rows(i & ":" & j).Select
не решает проблемы. Диапазон по прежнему статичен и определяется значениями переменных i и j, которые жестко заданы.
Как выделить диапазон, в котором номер одной или обеих строк вычисляется разными формулами при предыдущих вычислениях макроса ?
Попробовал видоизменить на
i = A1: j = A4
Rows(i & ":" & j).Select
при этом в ячейки А1 и А4 записал цифры 1 и 4, но не помогло, ругается.
Что-то делаю не так ?

miroed2

Цитата:

i = A1: j = A4

Здесь переменная i содержит текст "A1", а переменная j - "A4"
Правильно:
Код: Rows([A1] & ":" & [A4]).Select
'или
Rows(Cells(1, 1) & ":" & Cells(4, 1)).Select
'или
Rows(Range("A1") & ":" & Range("A4")).Select
'или
Rows(Range(i) & ":" & Range(j)).Select
'или
'...

Большое спасибо, vlth !
А сколько времени мной потрачено на поиск решения !
Что оно простое и существует - понимал.

miroed2, небольшое замечание по поводу Select и ... не только.

Оптимальная организация кода процедур не требует применения метода Select.

Необходимость применения Select - это:
1. выделение диапазона в процессе отладки процедуры;
2. выделение определённой ячейки в конце работы кода для удобства дальнейшей работы пользователя.

Следует понимать, что все приведённые примеры оперируют с диапазонами активного листа Excel, что в результате работы реальной программы может привести к неконтролируемому изменению, скажем, содержимого рабочих книг, и Вы об этом, может статься, не узнаете никогда.

Добрый день!
Помогите с макросом для импорта данных с интернет страницы. Необходим макрос, который бы запрашивал марку, модель, год выпуска, тип КПП и копировал результаты поиска с сайта, вставляя данные на листе по порядку, т.е. 1 машина в А1, вторая в А2, и так далее. Нужно для расчета стоимости в оценке автотранспорта. Вот сайт: http://auto.ria.ua/?target=search&event=little&category_id=0&state=0&city=0&marka=58&model=526&s_yers=2007&po_yers=2007&bodystyle=0&gearbox=0&type=0&drive_type=0&color=0&engineVolumeFrom=&engineVolumeTo=&raceFrom=&raceTo=&custom=1&damage=1&exchangeTypeId=0&saledParam=0&under_credit=0&price_ot=&price_do=&currency=1&auto_id=&order_by=0&search_button=%CF%EE%E8%F1%EA&page=0

Данные, которые нужны по авто, в таком виде: Peugeot 307 2007 г.в Запорожье Цена $ 14 500 Запорожье Тип кузова: Хэтчбек; Коробка передач: Типтроник; Цвет: Черный; Объем двигателя: 2.00 л. ; Пробег: 43 тыс.км;

Возможно сделать? Спасибо.

andrewkard1980
А в чем проблема-то? Записываете макрос создания веб-запроса к поизвольной странцие. Дальше смотрите какой параметр в URL за тчо отвечает(методом тыка), дальше генерируете URL и подставляете в заготовку из пункта 1

Спасибо!
С этим разобрался. Создал на листе списки для выбора авто, сгенерировал веб запрос, все работает. Одна проблема, необходимо htmlcode разбивать с помощью функций, поскольку возникает неправильная разбивка данных, я раньше делал так:
On Error Resume Next
outstr = Mid(htmlcode, InStr(1, htmlcode, "b-itemSeacrh") + 0, 10000)
On Error Resume Next
Set oHttp = Nothing
On Error Resume Next
Range("$A$50") = outstr
On Error Resume Next
outstr = Mid(htmlcode, InStr(1, htmlcode, "b-itemSeacrh") + 7000, 10000)
Set oHttp = Nothing
On Error Resume Next
Range("$A$51") = outstr
On Error Resume Next
outstr = Mid(htmlcode, InStr(1, htmlcode, "b-itemSeacrh") + 15000, 10000)
Возможно что то не так пишу, только пару дней назад сел разбиратся с ним
Со слова b-itemSeacrh начинается найденные машины, к каждой можно привязятся к слову HeaderLink (начало каждой машины). Вот теперь голову ломаю



Добавлено:
По аналогии с функцией excel mid написал для второй машины:
outstr = Mid(htmlcode, InStr(InStr(1, htmlcode, "b-itemSeacrh"), htmlcode, "HeaderLink") + 0, 10000)
Работает, интерестно, сколько вложений видерживает функция, вряд ли много...

Цитата:

Ищите источник ошибки при пошаговом выполнении процедуры.

етот не поможет, придется вручную искать, пошагово.
Спасибо за помощь

Добавлено:
Переделал цикл и все пошло,
правда теперь ишит перебором, ето немного дольше (наверное), но база не большая, думаю проблем не будет.

вопрос, как сделать чтоб висота строки подгонялась автоматом относительно содержимого.
Типа Формат => Строка => автоподбор висоти...
Кстати у меня ето не работает, всегда виставляет висоту 15,75 независимо от содержимого
СПС

Добавлено:
неработает так как у меня обєдененние яцейки, что посоветуете?

как правильно в 1с написать формулу условного форматирования в Excel
в Excel выглядить так:
Range("A10:C15").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$A10>0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
в 1с все правильно до ввода формулы.
Worksheet.Range("A10:C15").Select(); //выделение области
Область = Worksheet.Range("A10:C15");
Область.FormatConditions.Delete();
Область.FormatConditions.Add(2, "=$A10>0");
Область.FormatConditions(1).Interior.ColorIndex = 35;
как правильно написать строчку
Область.FormatConditions.Add(2, "=$A10>0");

NJCorp

Цитата:

неработает так как у меня обєдененние яцейки, что посоветуете?

Код: Sub Example()
With ActiveCell.MergeArea
If .MergeCells Then
.Rows.RowHeight = .Cells(1).Font.Size * 1.25 / .Rows.Count
End If
End With
End Sub

Господа, помогите пожалуйста с заданием)
Я полный нуб, а работу нужно сдать как можно скорее

Цитата:

В матрице R(6,7) найти диапазон значений элементов и произведение элементов 2-го столбца.

Элементы матрицы задаются вручную
Заранее благодарю!)

dimazt

Код: Область.FormatConditions.Add 2, 3, "=A10>0"

Ivanus8147rus
'arr - наш массив

Код: dim mn as long
dim mx as long
dim pr as long
mn=arr[0,0]
mx=arr[0,0]
pr=1
for i=0 to 6
for j=0 to 7
if arr[i,j]>mx then
mx=arr[i,j]
end if
if arr[i,j]<mn then
mn=arr[i,j]
if j=2 then
pr=pr*arr[i,j]
endif
end if
next j
next i

Drazhar, спасибо за то что откликнулись, только при попытки отредактировать некоторые строки выдает вот что.
Массив, как видите, объявил. Я так понимаю, ему действия не нравятся, может быть из-за формата Long?

Ivanus8147rus
пардон
Замените квадратные скобки на круглые

Drazhar, хм, научил программу читать с таблицы.
максимальное значение и произведение правильно определяет, а вот с минимальным всегда выдает "0", даже если его нет в таблице.
Проблема в изначальном присваивании mn= arr(0,0) (размерность массива arr(0 To 6, 0 To 7)) Как поступить?

Добавлено:
Хах, не важно =)
Просто заменил (0,0) на (1,1)

Помогите пожалуйста решить следующий вопрос. Нужно с помощью VBA сделать выборку данных из базы данных.
Имеем:
    - базу данных "PHCBase" которая находится на Microsoft SQL Server
    - таблицу "st" и "sa"
    - пользователя (знаем пароль пользователя)
присутсвует программа "PHC Advanced 2008" из которой с помощью языка T-SQL, получаю данные из разных таблиц
одной базы данных. В этой программе есть кнопка которая вносит эти данные в буфер обмена. Третьим шагом вношу эти данные
с помощью VBA это на чистый лист Exel-я, для дальнейшей работы. Хотелось бы сделать все это, как говорится "одним махом"
Возможно создать связь, как бы правильнее выразится, Лист1->таблица"st" , Лист2->таблица"sa", и т.д., а потом сделать выборку
с помощью VBA. Неустраивает слишком большой объем информации. В и-нете нашел пример, но немогу разобратся, чему равно:
    dbs =        (не могу понять к какому файлу привязиваться, ненашел файл с расширением ctDd)
    ctSheet=    (?)
    ctTarget=    (?)
Что значит следующая строка
    lbTidy:

Может возможно использовать код записанный при создании связи базы данных, с ячейками листа Exel-я.
[more=Пример.]
'Пример из и-нета

Sub SelectAndReturnRecords()
Dim dbs As Database
Dim rs As Recordset
Dim vtSql$
Dim numberOfRows

On Error GoTo ErrorHandler

ThisWorkbook.Activate

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Open the database
Set dbs = OpenDatabase(ThisWorkbook.Path & "\" & ctDb)

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' The Execute method is valid only with action queries.
'' Select queries contain a SELECT statement and can return records - action queries do not.
vtSql = ""
vtSql = vtSql & " SELECT * "
vtSql = vtSql & " FROM " & ctSheet
vtSql = vtSql & " WHERE Namex Like 'R*'"

Set rs = dbs.OpenRecordset(vtSql)

With ThisWorkbook.Sheets(ctTarget)
With .Cells(1, 1)
.CurrentRegion.Clear
'' Copies the contents of a DAO Recordset object onto a worksheet
numberOfRows = .CopyFromRecordset(rs)
End With
End With

'' The number of rows returned, but ..
'' MsgBox numberOfRows

'' .. here's an alternative
'' With rs
'' .MoveFirst ''Ensure we are at the first record before we go into the loop
'' .MoveLast ''Access/Jet thing - go here before counting
'' fRecordCount = .RecordCount ''Count the number of records
'' End With

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'' Close and tidy up
lbTidy:
dbs.Close

Set dbs = Nothing
Set rs = Nothing

Exit Sub

'' - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ErrorHandler:
Dim vtMessage$

vtMessage = ""
vtMessage = vtMessage & _
Chr(10) & _
Chr(10) & "Error Number: " & Err & _
Chr(10) & "Error Description: " & Error()

MsgBox vtMessage, vbInformation, ctByg

Resume lbTidy

End Sub
__________________________________________________________________________________

'Код записанный при создании связи между базой данных и Листом Exel-я

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=SQLOLEDB.1;Persist Security Info=True;User ID=vasyl;Data Source=guido\sqlexpress;Use Procedure for Prepare=1;Auto Trans" _
, _
"late=True;Packet Size=4096;Workstation ID=GUIDO;Use Encryption for Data=False;Tag with column collation when possible=False;Init" _
, "ial Catalog=PHCBase"), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdTable
.CommandText = Array("""PHCBase"".""dbo"".""st""")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceConnectionFile = _
"C:\Documents and Settings\Guido Wanner\Os meus documentos\As minhas origens de dados\guido_sqlexpress PHCBase st.odc"
.ListObject.DisplayName = "Tabela_guido_sqlexpress_PHCBase_st"
.Refresh BackgroundQuery:=False
End With
__________________________________________________________________________________

'Пример на "язике" SQL

Select st.Ref, st.Stock
from st
Where st.Ref Like '05t812'
[/more]

ИМХО ctDd, ctSheet и ctTarget - это Public переменные.
А lbTidy: для Resume lbTidy в ErrorHandler, начало выхода (всё закрываем)

ferias
dbs - указатель на файл базы данных cdDb (подозреваю что для sql сервера этот пример не подходит)
ctSheet - имя таблицы в базе
ctTarget - лист excel на который будут выведены результаты запроса

Нужна помощь
Задача такая
Внести массив A(N,M). Найти минимальный элемент матрицы. Все элементы строки и столбца, на пересечение которых он находится, заменить нулями.

Для задачи с массивом A(N,M) использовать матрицу
18 13 21 -1 21
-23 -32 6 10 20
а= 47 26 -15 14 -2
32 -6 -4 14 81
28 41 42 -28 -35

Champlo0
ты бы хоть какой-то код написал, а народ бы помог. А так...
[more=мой код]
Option Base 1

Sub asdf()
Dim B() As Variant
Dim A(5, 5) As Variant
Dim i As Integer
Dim j As Integer
Dim k, l As Integer
Dim mn As Variant

B = Array(18, 13, 21, -1, 21, -23, -32, 6, 10, 20, 47, 26, -15, 14, -2, 32, -6, -4, 14, 81, 28, 41, 42, -28, -35)
For i = 1 To 5
For j = 1 To 5
A(i, j) = B(5 * (i - 1) + j)
' для наглядности можно вывести на лист excel
' Cells(i, j) = A(i, j)
Next j
Next i

' поиск минимального элемента
mn = A(1, 1)
For i = 1 To 5
For j = 1 To 5
If A(i, j) < mn Then
mn = A(i, j): k = i: l = j
End If
Next j
Next i
' замена строки-столбца нулями
For i = 1 To 5
A(i, l) = 0
A(k, i) = 0
Next i

' для наглядности можно вывести на лист excel
'For i = 1 To 5
' For j = 1 To 5
' Cells(10 + i, j) = A(i, j)
' Next j
'Next i
End Sub
[/more]

Hugo121 и Baton34V - спасибо вам за отзыв
Так все же, чему равны эти переменные?
Я знаю что dbs это база данных "PHCBase", ну а вот как правильно это сформулировать"?
ctSheet это таблица "st", не напишу же что ctSheet=таблица"st"?


Цитата:

подозреваю что для sql сервера этот пример не подходит

возможно у кого нибудь есть пример?
И почему в примере использована инструкция SQL Select....From.....Where.....?

есть данные в столбцах А4 - I11000
нужно сделать выборку по столбцу А
- если значение в ячейке столца А = "Истина", то скопировать всю строку с данными на новый лист, напрмер "Истина"
- если значение в ячейке столца А = "Ложь", то скопировать всю строку с данными на новый лист, например "Ложь"
p.s. скопированные строки должны идти друг за другом без пропусков пустых строк
заранее сенкс

Автофильтр и копипаст чем не подходят?

Solenaja
да уж, это совсем просто, смысл код писать?
[more=код]Sub asdf()
Const strTrue = "ПРАВДА"
Const strFalse = "НЕПРАВДА"
Const strSheet = "Лист1"
t = 0
f = 0
Sheets(strSheet).Select
For i = 0 To (11000 - 4)
If Range("A" & (4 + i)).Value = strTrue Then
Range("A" & (4 + i) & ":I" & (4 + i)).Select
Selection.Copy
Sheets(strTrue).Select
Range("A" & (t + 1)).Select
ActiveSheet.Paste
t = t + 1
Sheets(strSheet).Select
End If
If Range("A" & (4 + i)).Value = strFalse Then
Range("A" & (4 + i) & ":I" & (4 + i)).Select
Selection.Copy
Sheets(strFalse).Select
Range("A" & (f + 1)).Select
ActiveSheet.Paste
f = f + 1
Sheets(strSheet).Select
End If
Next i
[/more]

Вообще-то слова ИСТИНА и ЛОЖЬ всё усложняют, наверное поэтому Baton34V их заменил...
Я тут немного подкорректировал, под задачу, только листам названия не давал - называйте, как получится, я по номерам обращаюсь.

Код: Option Explicit

Sub asdf2()
Dim strTrue As Boolean, strFalse As Boolean
Dim t As Integer, i As Integer, f As Integer

strTrue = True
strFalse = False
Const strSheet = "Лист1"
t = 0
f = 0
Sheets(strSheet).Select
For i = 0 To (11000 - 4)
If Range("A" & (4 + i)).Value = strTrue Then
Range("A" & (4 + i) & ":I" & (4 + i)).Copy Sheets(2).Range("A" & (t + 1))
t = t + 1
End If
If Range("A" & (4 + i)).Value = strFalse Then
Range("A" & (4 + i) & ":I" & (4 + i)).Copy Sheets(3).Range("A" & (f + 1))
f = f + 1
End If
Next i
End Sub