» Excel VBA (часть 2)

MaximuS G
ну и наворочено... ;-(((
прямо руки опускаются :-(
вот, пытался, например, понять, по какому принципу в ячейке I10 (Среда, Четверг) оказался ноль???? ("Плюс к этому в одной из 9ти ячеек надо проставить 0, в зависимоти от значени 27го ряда" - поясните)

и вот это, тоже непонятно про 27 ряд - "Значения в этом ряду должны быть минимальными плюсовыми" это, простите как?!

SERGE_BLIZNUK

Да, я же говорил... ))... Я думаю не стоит голову ломать...
Дело в том, что построить эти графики в ручную достаточно быстро, а вот написать код... наверное займет больше, чем делать вручную...

Минимальными плюсовыми - это я имел ввиду ближе к нулю, то-есть в идеале ноль..
По большому счету, ноль может ставиться в любом месте, лишь бы при изменение значения на ноль в 27 ряду не измениться значение на минусовое...
Будет ли сложно написать код, если мы исключим например условия про ноль, и про оранжевый квадратик...

То-есть только чтоб заполнить в зависимости от ряда 27...
Сейчас подумаю, как написать словами код... ))



Добавлено:
1) Рассмотреть ряд С11:Q11:
Первая ячейка С11, если значение ячейки ниже ее на 16 рядов ниже нуля С27<0, то заполняем 8 ячеек справа, переход на следующий ряд
Если С27>0, то рассматриваем следующую ячейку в ряду
Вторая ячейка D11, если... аналогично первой
Доходим до ячейки J, здесь получаеться, что если мы ОТ НЕЕ заполним ячейки, то мы вылизим за границу колонки Q, получаеться заполнять надо от J-1... Не представляю как это сделать
Соответсвенно ячейка K, будет заполняться от K -2, L -3 и т.д.
2) Рассмотреть ряд С12:Q12, аналогично...

Вот так я думаю...
Еще один момент, может я придумал что-попало из-за неграмотности... Если немного глупо, Вы мне скажите, и мы оствим эту задачу... Просто потом, когда нужно будет что-то реально необходимое, Вы можете сказать: "А он опять какую-то фигню придумал"

MaximuS G вот решение:

Код: Sub Fill_C_Range()
Dim iRow As Integer, jColumn As Integer, jMax As Integer

' ВНИМАНИЕ!! сначала ВСЁ удалим в области C10:Q24
Range("C10:Q24").Clear

For iRow = 10 To 24 'это заполняемые ряды, кстати, их не 14, а 15
' в каждом ряду будем проходить по всему диапазону от Cirow до Qirow
' столбец C это 3 столбец Q = 17
For jColumn = 3 To 17
If Cells(27, jColumn).Value < 0 Then
jMax = jColumn + 9 - 1
If jMax > 17 Then jMax = 17
With Range(Cells(iRow, jColumn), Cells(iRow, jMax))
.Value = 1
.Interior.ColorIndex = 6
End With
Exit For
End If
Next

Next iRow
End Sub

SERGE_BLIZNUK

СПАСИБО
Сейчас буду разбирать...

Добавлено:
SERGE_BLIZNUK

Цитата:

вот решение

Все гениальное - просто... не могли бы Вы для начинающих немножко добавить комментариев, а то я совсем не могу понять...

Особенно вот это:

Цитата:

jMax = jColumn + 9 -

Цитата:

With Range(Cells(iRow, jColumn), Cells(iRow, jMax))

Подскажите способы остановки кода:


Код:
Sub aagee()

Range("B5").Select
ActiveCell.Offset(13, 0).Select
If Not ActiveCell.Value = "X" Then

'Тут нужна полная остановка дальнейшего выполнения кода.

Else
End If
MsgBox "Poehali"
End Sub

nopoxz
Exit Sub

nopoxz
может поможет выход из макроса??
Exit Sub
??


Добавлено:
visual73 - за Вами не успел! :-)

visual73
SERGE_BLIZNUK

Спасибо.

Добавлено:
В столбце пронумерованы ячейки.
На картинке пример.
Большое кол-во строк находятся в хайде. Это для того, чтобы относительное расстояние между ячейкой "B5" и ячейкой с "X" сохранялось. Макрос добавляет очередную строку в конец, и хайдит "B6".

"B5" имеет постоянный адрес, а адрес "X" меняется от увеличения ячеек в хайде.
Основной момент - мне нужно попадать в ячейку "Х". Пробывал Offset из "B5" - но не работает при строках в хайде.

Есть вариант на поиск ячейки через Loop, но этот вариант я оставил на крайний случай.

Главный вопрос: Подскажите, есть ли способы мне как-то связаться с ячейкой "X" (чтобы из неё вставлять новые строки с помощью Offset) имея постоянный адрес "B5" и постоянное относительное расстояние (не считая строки в хайде)???

Добрый день! Подскажите плиз можно ли в excel 2007 запускать макросы в защищенной книге, и если можно то где можно это настроить. В центре управления безопасностью галочка стоить - "включить все макросы".
Или подскажите как можно обращаться в макросах к листам, вне зависимости их названия и перестановок местами.

SERGE_BLIZNUK

Сам разобрался ... ))

Добрый день. Посоветуйте, пожалуйста, как программно подключить дополнительные библиотеки, например, "Microsoft Scripting Runtime" или "Microsoft ActiveX Data Objects 2.8 Library"?
В Access-е для этого есть класс "References". А что можно предпринять в Excel?

Hugh ну, ответ на Ваш вопрос я не знаю и, если честно, мне тоже очень интересно узнать ответ на него.
Но, с другой стороны, практически польза в этом была бы, если макросы создавались в run-time... макросы Вы же не будете создавать программно? А если нет, тогда при написании макроса можно включить нужные референсы.

Хотя, если найдёте ответ - напишите, интересно решение!




Добавлено:
Hugh
оп-с... то ли Вы же на планетаЭксель об этом же спросили, то ли совпадение...

но решение проблемы есть здесь - Early binding

позволю его здесь процитировать (вдруг кому пригодится ;-)
[more]

Код:
'программное подключение библиотеки

'Source: http://msoffice.nm.ru/faq/macros/module.htm#faq179

Option Compare Text

Private Sub VBProject_References1()
Dim iPath$, iFileName$, iCount%
iPath$ = Environ("WinDir")
'iFileName$ = iPath$ & "\System32\Scrrun.dll" 'Microsoft Scripting Runtime
'iFileName$ = iPath$ & "\System32\FM20.dll" 'Microsoft Forms 2.0 Object Library
iFileName$ = Application.Path & "\MSWORD.OLB" 'Microsort Word 11.0 Object Library
If Dir(iFileName$) <> "" Then
With ThisWorkbook.VBProject.References
For iCount% = 1 To .Count
If .Item(iCount%).FullPath = iFileName$ Then
MsgBox "Эта библиотека уже подключена", , ""
Exit Sub
End If
Next
.AddFromFile Filename:=iFileName$
End With
Else
MsgBox "Отсутствует нужный файл", , ""
Exit Sub
End If
MsgBox "Библиотека подключена!", 64, ""
End Sub

Меня этот вопрос тоже интересует. При переносе файла на другую машину, при выполнении макроса Ехель начинает ругаться и требовать включения библиотек.

SERGE_BLIZNUK, спасибо, это то, что нужно. Гениально. В хелпе Excel про это практически ничего нет.
Кстати, на планетеЭксель спрашивал не я, так что, видимо, совпадение.

skotov

Цитата:

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

ActiveWorkbook.Colors(17) = RGB(0, 97, 146)

А зачем вам делать это в виде автозапуска? Можно реализовать в виде макроса в специальном XLS файле, который будет выводить диалог выбора конкретных XLS файлов, последующим их открытием в цикле, изменением палитры, сохранением результата и закрытием. В будущем можно этот XLS файл переделать в надстройку.


Добавлено:
nopoxz

Цитата:

Подскажите, есть ли способы мне как-то связаться с ячейкой "X" (чтобы из неё вставлять новые строки с помощью Offset) имея постоянный адрес "B5" и постоянное относительное расстояние (не считая строки в хайде)???

А просто по индексу нельзя обратиться: Cell(Row,Column) ?
1. Координаты требуемой ячейки можно, к примеру, хранить в какой-нибудь скрытой ячейке и обновлять всякий раз, когда добавляется строка.
2. Если ячейка сама не меняется (вставка строк/колонок до и после не в счёт), то можно, к примеру, сделать следующий трюк. Делаем в 2х ячейках с фиксированным и заранее известным адресом, например, A1 и A2 такие функции:
=СТРОКА($B$175) =СТОЛБЕЦ($B$175)))
$b$175 указывает на вашу ячейку с X. Функции возвращают абсолютный номер строки и столбца вашей ячейки с крестом. При изменении положения ячейки новые координаты появятся в A1 и A2. Зная абсолютные координаты можно получить объект типа Range при помощи Cells(Row,Column) и использовать его для работы с Offest():
Cells(Row,Column).Offset(...) хотя с таким доступом к ячейке можно без Offset() обойтись, просто использовать Cells().

день добрый, не подскажите как автоматически нажимать "да",когда Эксель при закрытии файла спрашивает,сохранить или нет содержимое буфера??

Цитата:

изменением палитры, сохранением результата и закрытием. В будущем можно этот XLS файл переделать в надстройку.

Просто для поддержания разговора...
Вот здесь, на планетаЭксель была выложена надстройка от ZVI, которая восстанавливает стандартную палитру.

Подскажите пожалуйста как разорвать связи в Excel, сразу все, если такое возможно.


Код: ActiveWorkbook.BreakLink Name:= "..." , Type:=xlExcelLinks

Товарищи, помогите пожалуйста! Вы тут все знаете что к чему, а я вообще в прогрммировании ничерта не понимаю. Думаю, что для вас труда не составит. Нужно решить несколько задачек.( Буду очень признательна!

1. Даны целые числа х1, х2, ..., х55. Вычислить величину х1(х2+х3)(х4+х5+х6)...(х44+х47+...+х55).
2. Дана непустая последовательность слов из строчных латинских букв; между соседними словами - запятая, за последним словом - точка. Напечатать все буквы, которые входят в наибольшее количество слов этой последовательности.
3. Напечатать текст из 100 или более литер (любой), удалив из него повторные вхождения каждой литеры.

Еще появился вопросик:
Как сделать, что бы при каждом inputbox менялись его параметры (ввод, привет), тоесть первый раз "ввод", "привет"... второй вызов "ввод1", "привет1"... n-раз "ввод n" "привет n" ??? Думаю сам, но пока никак


Код:
For i = 7 To 21

On Error Resume Next
iNumber = Application.InputBox("ввод", "привет")
If iNumber = 0 Then
Cells(i, 5) = 0
Else:
Cells(i, 5) = iNumber

End If
Next

MaximuS G

Передавать аргументы функции Inputbox не явными значениями, а переменными, которые задавать где-то раньше.


Код:
For i = 7 To 21

arg1="ввод"+Cstr(i)
arg2="привет"+Cstr(i)

On Error Resume Next
iNumber = Application.InputBox(arg1, arg2)
If iNumber = 0 Then
Cells(i, 5) = 0
Else:
Cells(i, 5) = iNumber

End If
Next

ecolesnicov

Спасибо.. )) Извините, наверное неточно написал... Я имел ввиду, что значения должны быть совсем разные... ну сейчас получаеться так: ввод1, ввод2(сам же так написал!), а мне нужно что бы было например: упр, адм, стсмен, и т.д...

Добрый день!

1. В некой ячейке, скажем А1, с периодичностью в n секунд происходит вычисление значения (ввод данных в исходный лист осуществляется внешним приложением);

Можна ли в Екселе реализовать следующее:

1.После каждого такого вычисления сохранять его результат в колонке, скажем В, а рядом в колонке С в той же строке сохранять его временные метки.
2. По достижению в колонке В строки 65 тыс (может понадобиться и меньше) происходил сдвиг данных вверх, тоесть самые старые данные удалялись, а внизу прописывались самые свежие данные. Что-то похожее на "временное окно"...

Если в самом Екселе - еще куда ни шло разбираюсь, то в VBA - не знаю с чего и начать/подступиться?!

НЕ ПРОГРАММИСТ...

Спасибо!

MaximuS G
Суть дела от этого не меняется. В любом случае передаем аргументы функции Inputbox не явными значениями, а переменными. А вот как - вариантов очень много ...
1) можно по примитивному через If ... elseif ... и т.д.
2) более "красивый" вариант: Select case ...
3) Заранее задаем массив (array) значений, а в момент присваивания - выбираем из этого массива по i.
4) выносим это все в отдельную функцию, результатом которой будет возвращение этих переменных.

Добавлено:
IgrokBB
Да. реализовать все перечисленное можно без особых проблем.
Начинать надо с записи макросов и их рассмотрения (в Excel делаем какие-то действия, записываем макрос - смотрим как эти действия "выглядят" в VBA). А дальше - документация ... Я тоже не программист - мне кажется что основным фактором способствующем моему освоению VBA стало понимание объектной модели Excel - как только я в нее врубился - дело пошло очень даже хорошо! Заранее извиняюсь у профи - мнение сугубо субъективное ...

ecolesnicov

Спасибо, через If код очень длинный будет, у меня 15 значений, а если их 1000!!!

Вот код, могли бы Вы мне подсказать как сделать короче и красивее, если не тяжело с предложеным Вами Select case и Array


Код:
For i = 7 To 21

arg = "vvod znacheniy"
arg2 = "upr"
arg3 = "adm"

If i = 7 Then
On Error Resume Next
iNumber = Application.InputBox(arg2, arg)
If iNumber = 0 Then
Cells(i, 5) = 0
Else:
Cells(i, 5) = iNumber

End If
End If

If i = 8 Then
On Error Resume Next
iNumber = Application.InputBox(arg3, arg)
If iNumber = 0 Then
Cells(i, 5) = 0
Else:
Cells(i, 5) = iNumber
End If
End If

Next

Здравствуйте! Подскажите, как правильно реализовать следующую идею.
Имена листов в виде Лист26.Name находятся в листе excel , макрос должен считывать названия листов из листа справочника. Думаю, что код должен походить на следующее
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets("spr").Range("C1").Value).UsedRange.Address
Содержимое С1: Лист26.Name
Если вместо ThisWorkbook.Worksheets(ThisWorkbook.Worksheets("spr").Range("C1").Value).UsedRange.Address
Написать
ThisWorkbook.Worksheets(Лист26.Name).UsedRange.Address
То ошибки не возникает, а так пишет “run-time error ‘9’ Subscript out of range”. Такое ощущение что ThisWorkbook.Worksheets("spr").Range("C1").Value возвращает текст, а там должен быть объект, может есть какая функция, для приведения текста к названию объекта?
Подскажите плиз, как можно такое реализовать, или есть какие соображения, чтоб обращаться к листам вне зависимости их имени и место нахождения и чтоб их «абсолютные названия» можно было хранить в одном листе справочнике.

MaximuS G

Цитата:

Спасибо, через If код очень длинный будет, у меня 15 значений, а если их 1000!!!

Сделайте проще, заведите себе специальную вкладку Excel, где в столбцы A и B вбейте все параметры: в A - первый, в B - второй и считывайте их от туда:

Код: For index = 1 To 1000

arg1=Sheets("Data").cells(index,"A") ' Data - ярлычок (название) листа
'с необходимыми параметрами функции InputBox()
arg2=Sheets("Data").cells(index,"B")

On Error Resume Next
iNumber = Application.InputBox(arg1, arg2)
If iNumber = 0 Then
...
Else:
...

End If
Next

ksodi
так ЧТО нужно?
сначало Вы пишите "макрос должен считывать названия листов из листа справочника"
потом "там должен быть объект"

если нужна ссылка на ОБЪЕКТ, то используется SET
типа того Set ws = Worksheets(Sheets("spr").Range("C1").Value)

Подскажите, можно ли как-то умешить объём кода:


Код:
Sub Bar1()

'Кусок1
Range("C5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
Range("B5").Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B5").Offset(2, 0).EntireRow.Insert

'Кусок2
ActiveCell.Offset(1, 0).Value = ActiveCell.Value + 1
ActiveCell.Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, 0).EntireRow.Insert


'Кусок3
ActiveCell.Offset(1, 0).Value = ActiveCell.Value + 1
ActiveCell.Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(-10, 0).EntireRow.Hidden = True

End Sub

nopoxz
А заменить Range("B5").Offset(2, 0) на Cells(Row,Column), тогда можно Range("C5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False в отдельную процедуру вынести, передавая ей только координаты вставки в качестве параметров.

Добавлено:
Из ActiveCell всегда можно вытащить её абсолютные координаты.