» Excel VBA (часть 3)

AndVGri


Цитата:

создаёт 6 новых книг. Зачем?

эм, черт, мне нужно 6 листов

Цитата:

Код, честно говоря, не читаем, насколько понимаю

Это я уже массивы делал, код пустой. Читаю его в препрыжку, так как совмещение админских и программерских задач тяжело дается, а когда дергают постоянно, тяжело вникнуть.

Цитата:

Dim FROMCOLSCOUNT(1 To 6) As Integer,

у меня неизвестное количество строк в каждой книге, по этому так я объявить не смогу.

AndVGri опять ты меня выручаешь)) спасибо!

Цитата:

у меня неизвестное количество строк в каждой книге, по этому так я объявить не смогу.

Именно поэтому объявляешь
Цитата:

Dim FROMROWSCOUNT(6) As Long

или ROWS - это чтобы враг не догадался? А FROMCOLSCOUNT COLS не объявляешь, чтобы себя путать?
Для вставки книги и листов

Код:
Dim pBook As Workbook

Set pBook = xl.Workbooks.Add
'вставляем недостающие листы
For i = pBook.Worksheets.Count + 1 To 6
pBook.Worksheets.Add
Next i
'переименовываем листы
For i = 1 To 6
pBook.Worksheets(i).Name = sheet_arr(i)
Next i

AndVGri

Вопрос по коду.
Когда я вручную создаю файл excel, то у меня по умолчанию в книге три листа.
А когда пишу
Код: Set w = xl.Workbooks.Add.Worksheets(1)

unit4
Для того, чтобы создать новую рабочую книгу с требуемым количеством листов, можно использовать код (например, для книги с 5-ю листами):

Код: Application.SheetsInNewWorkbook = 5
Workbooks.Add

unit4
Добавлю к ответу SAS888
функция Add коллекции Workbooks содержит ещё один вид параметра - путь к книге-шаблону. То есть, создаётся книга Excel с необходимыми листами, их названиями, форматированием, оформлением и сохраняется, допустим d:\path\mytemplate.xls(xlsx, xlsm). Теперь мы можем создать новую книгу, используя myTemplate. Очень часто такой метод бывает удобен, так как позволяет убрать из макроса кучу кода по форматированию результата при создании типовых книг, да и скорость работы из-за этого вырастет.

Set pBook = xl.Workbooks.Add("d:\path\MyTemplate.xls")

Помогите, горю!..

Сразу скажу: шапку читал, мой подход не "сделайте мне, сам ничего знать не хочу", просто действительно горю...

Проблема такая: надо числовые значения из столбца Е дополнить по условию и записать результат в столбец F, с проверкой исходных данных на соответствие числовому формату.
C условиями и вычислениями проблемы нет, есть проблема с последовательным перебором ячеек и записью данных в соответствующие. Ну хоть убей, не понимаю я логики Экселя в этом вопросе.

Mizanthrope
Последовательный перебор ячеек и запись данных в соответствующие, делаются, например, так:

Код:
For Each r In Columns(5).Cells
r.Offset(, 1).Value = r.Value + 1
Next r

panda3
Спасибо!
Я полночи бился, сделал. Немножко не так, но сделал.
Теперь вопрос в следующем: как заставить ЭТО работать на всех листах? Конструкция

Код: For Each Worksheet In Worksheets
...
Next Worksheet

Mizanthrope

Код: For Each Item In ActiveWorkBook.Worksheets
MsgBox Item.Name
Next

Mizanthrope

Цитата:

привести ячейки к виду Currency, с двумя знаками после запятой и значком евро?

myRange.NumberFormat = Chr$(136) & " #,##0.00"

Господа, может кто-нибудь поделиться работающим примером, как с помощью vba можно парсить курсы валют с сайта Нацбанка Беларуси - http://nbrb.by/statistics/Rates/RatesPrint.asp?fromDate=2012-1-12
Интересует получение в ячейке курса указываемой валюты на выбираемую дату.

notaltr
Парсить HTML выдачу на VBA? Да ну его... Создай на листе веб-запрос с этого адреса и рули им из VBA, типа:
myRange.QueryTable.Connection = "URL;http://nbrb.by/statistics/Rates/RatesPrint.asp?fromDate=2012-1-10"
myRange.QueryTable.Refresh
Потом останется только найти в первой колонке код валюты, и в третьей посмотреть курс. Можно вообще без VBA, простой формулой. Его, правда, еще в число надо будет конвертнуть. Или в Белоруссии десятичная точка?

C HTML - согласен, геморно. А если с XML работать? Сайт-то предоставляет разные варианты для вебмастеров, и даже пример проги на VB.NET на их сайте есть... http://nbrb.by/statistics/Rates/webservice/
http://nbrb.by/statistics/Rates/XML/
Нашел в инете пару примеров парсинга с yahoo, но что-то не получается адаптировать.
Ну вот что нам, дилетантам, делать, если хочется элегантного решения задачи?

notaltr
Можно, формируете URL, дата в нем присутствует.
Дальше:

sURL = "http://nbrb.by/statistics/Rates/RatesPrint.asp?fromDate=2012-1-12"
Set oHttp = CreateObject("MSXML2.XMLHTTP")
With oHttp
.Open "GET", sURL, False
.Send
sHtml = .responseText
End With

Получите код странички в переменной sHtml, и дальше функциями mid и instr ищете нужную часть строки и выводите в нужную Вам ячейку.

добрый день, мастера VBA. Я только начал изучать VBA, до этого писал на дельфи. Есть вопрос, который ни как не могу решить
Я создал пользовательскую функцию, типа TempFunc(text_1) которая вызывается из листа эксель так =TempFunc(A1)
все нормально работает до момента, когда я хочу поменять данные в ячейке не только в той, из которой вызывается эта функция, но и в соседней.
сейчас делают так

Dim col_1 As Integer 'колонка
Dim row_1 As Integer 'строка

col_1 = Application.Caller.Column 'получаем номер колонки, из которой вызвали функцию
row_1 = Application.Caller.row 'получаем номер строки, из которой вызвали функцию

Cells(row_1 + 2, col_1).Activate
Cells(row_1 + 2, col_1).Text = "какая нибудь фигня"
дебаггер останавливается на последней строчке. Как же мне заменить текст в соседней ячейке?

zvyagaaa
1. Свойство Text для объекта Range (Cells(x,y) - это он) только для чтения, поэтому отладчик и ругается.
2. Excel блокирует изменение значений, оформления и т. п. для ячеек в функциях (вроде как есть обходной метод, пометить функцию как MacroType, только я не знаю как). Чтобы изменить используйте процедуры
Public Sub MySub()
End Sub

P. S. Вызов процедуры из функции к требуемому результату не приведёт.

zvyagaaa
Зачем .text вообще писать? Без него отлично работает!

Функциям листа вообще запрещено изменять что-либо на листе. Вам нужно написать обработчик события Worksheet_Change и там менять уже что угодно.

AndVGri
aidomars
panda3
спасибо за

Цитата:

Функциям листа вообще запрещено изменять что-либо на листе. Вам нужно написать обработчик события Worksheet_Change и там менять уже что угодно.

буду раскуривать Worksheet_Change на этот счет. Просто нигде в той литературе, что я читал не описано что запрещено вот я и запарился.

Присваиваю столбцу таблицы в Office 2010 через обработчик элемента "кнопка" формулу:

Код: Range("Тбл_3[CLMN]").FormulaR1C1 = _
"=СЧЁТЕСЛИМН(Тбл_3[Дата],Тбл_3[@Дата],Тбл_3[Номер П/П],Тбл_3[@[Номер П/П]],Тбл_3[Сумма],Тбл_3[@Сумма],Тбл_3[ИНН],Тбл_3[@ИНН])"

Undaster
Используйте FormulaR1C1Local или названия формул рабочего листа на английском

AndVGri, заменил на COUNTIFS — всё прекрасно заработало, спасибо!

P.S. Попробовал:

Код: Range("Тбл_3[CLMN]").FormulaR1C1Local = _
"=СЧЁТЕСЛИМН(Тбл_3[Дата],Тбл_3[@Дата],Тбл_3[Номер П/П],Тбл_3[@[Номер П/П]],Тбл_3[Сумма],Тбл_3[@Сумма],Тбл_3[ИНН],Тбл_3[@ИНН])"

Может быть кому то будет интересно, - нашёл причину предыдущей ошибки для локализованной версии Excel:

в FormulaR1C1Local - параметры функций необходимо перечислять через точку с запятой (";"),
тогда как те же параметры в FormulaR1C1 должны быть перечислены через запятую (",").

Специалисты, откликнитесь пожалуйста!

Есть макрос отправки сообщения из Excel (приведен ниже), как его модифицировать так, что бы отправлялся диапазон ячеек с активной страницы, на адреса указанные в определённой ячейке (на активном листе), а так же тема письма подставлялась из другой ячейки:

Указанный макрос, создаёт сообщение Аутлок, так же создаёт копию активного листа, но копия не прикреплена к сообщению (просто открыта), как модифицировать макрос так, чтобы копия активного листа прикреплялась к создаваемому сообщению?


Код: Sub Sendmail_ActiveBook()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next


With OutMail
.To = Range("Q2").Value
.Subject = Range("Q3").Value
.Body = Range("Q4").Value
.Attachments.Add (ActiveWorkbook.ActiveSheet.Copy)
.Display
End With

On Error GoTo 0
Set OutMail = Nothing

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Цитата:

.Attachments.Add (ActiveWorkbook.ActiveSheet.Copy)

Вот здесь у Вас ошибочка. Команда "ActiveWorkbook.ActiveSheet.Copy" копирует активный лист в буфер обмена (т.е. в память). А прикрепить к письму можно только объект. Следовательно, активный лист Вам нужно сохранить в какой-нибудь временный файл, его прикрепить к телу письма, а после отправки письма удалить этот временный файл.

psiho Спасибо, суть понятна, но я полный ноль в программировании.
В общем, буду пытаться освоить методом научного тыка.
Если есть какой нибудь пример, как это сделать, буду очень благодарен.

Цитата:

Если есть какой нибудь пример, как это сделать, буду очень благодарен.

Лови:

Код: Sub Sendmail_ActiveBook()
Dim OutApp As Object, wbTemp as Workbook
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Application.EnableEvents=false
Application.DisplayAlerts=false

Set wbTemp=Workbooks.Add
ThisWorkbook.Activate
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

ActiveWorkbook.ActiveSheet.Copy Before:=wbTemp.Worksheets(1)
wbTemp.SaveAs ("C:\БлаБлаБла.xls")
wbTemp.Close


With OutMail
.To = Range("Q2").Value
.Subject = Range("Q3").Value
.Body = Range("Q4").Value
.Attachments.Add ("C:\БлаБлаБла.xls")
.Display
End With

On Error GoTo 0
Set OutMail = Nothing

cleanup:
Set OutApp = Nothing
Kill ("C:\БлаБлаБла.xls")

Application.EnableEvents=True
Application.DisplayAlerts=True
Application.ScreenUpdating = True
End Sub

psiho Благодарю, извиняюсь что не сразу ответил, работы навалилось, буду разбираться, о результатах обязательно отпишу.

Добавлено:
psiho Ещё раз огромное Вам спасибо за готовый макрос, код работает на 100%.

Добрый день, профессионалам.

Снова обращаюсь к вам за помощью.
Суть вопроса такова: Ежедневно делается рассылка уведомлений в 26 регионов.
Есть файл, в котором 27 страниц, на первую странице помещаются данные из которых формируются (посредством работы фильтрами, и переносом на страницу региона) уведомления. После разноса данных по страницам, копия страницы отравляется в регион (посредством макроса, в адаптации которого под конкретную ситуацию, оказал еоценимую помощь psiho, за что ему огромное человеческое СПАСИБО).

На данный момент стоит задача автоматизировать разнесение данных по страницам, (так чтоб любой даже неподготовленный человек смог обработать данные и отправить уведомление).

Я по недопониманию вопроса посчитал, что можно просто записать макрос (штатными средствами EXCEL), но оказалось всё не так просто.

Ниже макрос записанный штатными средствами EXCEL, но есть вопросы которые не знаю как решить:

Т.к. уведомления рассылаются нарастающим итогом, нужно чтоб информация за следующий день, добавлялась после данных внесенных днём ранее (т.е начиная после последней не пустой ячейки).

Как указать макросу, что данные должны вставляться на страницу с первой незанятой строки, а так же как указать макросу что копировать данные при работе с фильтрами нудно со 2 несвободной строки?


Код:
Sub ОБРАБАТЫВАЕМ()
Selection.AutoFilter Field:=3, Criteria1:="БЕЛГОРОД"
Rows("1769:1802").Select
Selection.Copy
Sheets("Бегород").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("ДАННЫЕ ПО EMS Report").Select
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=2, Criteria1:="Владивосток"
Selection.AutoFilter Field:=3, Criteria1:="ВЛАДИВОСТОК СЦ"
Rows("135:199").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Владивосток").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("ДАННЫЕ ПО EMS Report").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=2, Criteria1:="Волгоград"
Selection.AutoFilter Field:=3, Criteria1:="ВОЛГОГРАД СЦ"
ActiveWindow.SmallScroll Down:=-6
Rows("208:237").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Волгоград").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("ДАННЫЕ ПО EMS Report").Select
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=2, Criteria1:="Воронеж"
Rows("238:281").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Воронеж").Select
Rows("2:2").Select
ActiveSheet.Paste
Sheets("ДАННЫЕ ПО EMS Report").Select
ActiveWindow.SmallScroll Down:=-18
Selection.AutoFilter Field:=2
ActiveWindow.SmallScroll Down:=-294
Rows("2:65000").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub

Цитата:

Суть вопроса такова: Ежедневно делается рассылка уведомлеСуть вопроса такова: Ежедневно делается рассылка уведомлений в 26 регионов.

А если у Вас завтра будет не 26 регионов, а 84? Каждый раз макрос дописывать? Не, так дело не пойдет. Короче, после праздников попробую помочь. Вопрос только в свободном времени на работе (сам программистом VBA работаю). Киньте мне в личку структуру первой страницы файла и по каким полям фильтровать,а то у Вас то по одному критерию фильтруются данные, то по двум.







Добавлено:

Цитата:

Sheets("ДАННЫЕ ПО EMS Report").Select
ActiveWindow.SmallScroll Down:=-18
Selection.AutoFilter Field:=2
ActiveWindow.SmallScroll Down:=-294
Rows("2:65000").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

На данном листе каждый день будет новая информация?