» Excel VBA (часть 2)

Виноват. В спешке пропустил один параметр.
Вот работающий код.

Sub searching()
r = 1 'Номер строки, с которой начнется запись вычленных строк в другом листе.
Finish = LastRow() 'Если опустить параметры, то функция посчитает непустые строки в первом столбце на активном листе, активной рабочей книги.
For i = 1 To Finish
If Left(Cells(i, 1), 3) = "Упр" Then 'Находим строку, начинающуюся с "Упр"
If Left(Cells(i + 1, 1), 2) = "Не" Then 'Находим строку, начинающуюся с "Не"
'Добавляем вычлененные строки на лист "ИмяЛиста"
Sheets("Лист2").Cells(r, 1) = Cells(i, 1)
' с - № колонки в которую делается запись
Sheets("Лист2").Cells(r + 1, 1) = Cells(i + 1, 1)
r = r + 2
End If
End If
Next i
End Sub

David_Kats
работает, только если Finish задавать точно кол-во строк, Finish = LastRow() - так нет

немного передалав работает так

Код: Sub searching()
Dim FirstRow&, LastRow&
FirstRow = ActiveWorkbook.ActiveSheet.UsedRange.Row
LastRow = FirstRow + ActiveWorkbook.ActiveSheet.UsedRange.Rows.Count - 1
r = 1 'Номер строки, с которой начнется запись вычленных строк в другом листе.
For i = FirstRow To LastRow
If Left(Cells(i, 1), 3) = "Упр" Then 'Находим строку, начинающуюся с "Упр"
If Left(Cells(i + 1, 1), 2) = "Не" Then 'Находим строку, начинающуюся с "Не"
'Добавляем вычлененные строки на лист "ИмяЛиста"
Sheets("Лист2").Cells(r, 1) = Cells(i, 1)
' с - № колонки в которую делается запись
Sheets("Лист2").Cells(r + 1, 1) = Cells(i + 1, 1)
r = r + 2
End If
End If
Next i
End Sub

Объясняю принцип работы LastRow()
Функция начинает пробегать все строки снизу с 65536-й строки и поднимается вверх по указанному столбцу (или по первому, если этот параметр опущен) до тех пор, пока не встретит непустую ячейку в этом столбце. Номер строки, где встретилась эта первая непустая ячейка и есть возвращаемое значение функции. попробуй задать все параметры для этой функции. Укажи имя книги, имя листа, где выполняется подсчет строк (в твоем случае это "Лист1"), и номер столбца по которому считаются непустые строки.
Все должно работать. Функция написана очень давно и приводится во многих книгах. Доработана мной для универсального применения и работаю я с ней во всех своих кодах. Так что все проверено временем.

Люди добрые, подскажите хоть в какую сторону копать по моему вопросу чуть выше...

Pravoved90
2. If Range("A1").Value & Range("B1").Value & Range("C1").Value <> "" Then
MsgBox ("!!!")
End If

1. находишь ПЕРВУЮ ПУСТУЮ ячейку
даллее см. пункт 2. и НЕМНОГО думаешь .... чуть исправляешь ... и только тогда вставляешь значение ...

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

Должна же бы функция, работающая с датами.
Все перелопатил, ничего не нашел.

WowGun
Спасибо за ответ. По п2 немного разобрался написанием примерно такого:
If IsEmpty(Cells(1, i)) And IsEmpty(Cells(1, i + 1)) And IsEmpty(Cells(2, i)) And IsEmpty(Cells(2, i + 1)) Then
Только не пойму, можно ли тут задать диапозон значений(типа IsEmpty(Cells(ОТ 1 до 10, i)) ),
чтобы не писать километровую строчку...

mistx
Как варианты: 1.сделать копию строки, где каждые 5 ячеек пустые, 6-7 - с буквой О. И подставалять под нужное значение.
2. Создать макрос, в который задать заполнение двух ячеек после пяти пустых.
2.1. Его же можно применять, если надо конкретная привязка к цифре.:
Допустим в ряд А ставяться О, в ряде В - цифры. Задать: Если отнять дату X от даты У = 6 или 7(т.е суббота или воскр), ставить О на ячейку выше в ряде В. При этом выполнять счет в ряде А от первой пустой ячейки в Ряде В(т.е. после предыдущих выходных, где уже стоит О) Можно записать как "проводить все расчеты с диапозоном А1:A50, кроме ячеек, которые <> нулю(то есть заполнены)
И так по циклу.
Как записать это - не разбирался, немного покопайтесь - и все получится.

mistx
А функция =ДЕНЬНЕД(дата) не подойдет? 6 - суббота, 7 - воскресенье.

mistx
Weekday(date, [firstdayofweek])
DatePart(interval, date[,firstdayofweek[, firstweekofyear]])
WeekdayName(weekday, abbreviate, firstdayofweek)

mistx в свое время делал шаблон с макросом в котором два выпадающих списка: в одном выбирается год, в другом месяц. На основе этих двух полей в шаблоне таблицы раставляются дни недели, сб и вскр окрашивались в зеленое, если в месяце было только 28 дней то 29, 30 и 31 число окрашивалось в серенькое. Этот маркос у меня на старом винте, который еще поискать надо. Если уж очень хочется и шипко не понятно как сделать могу к выходным поискать этот файлиг

Народ, подскажите, что здесь не так:
Записал макрос по окрашиванию диапозона ячеек в зеленый цвет:
Sheets("Лист1").Range("I6:I8").Select
Selection.Font.ColorIndex = 10
End Sub

Записал в общем модуле. При выполнении из Листа1- работает, при выполнении из другой книги Пишет ошибку "Метод select из класса range завершен неверно"
В чем может быть проблема?...

Добавлено:
Уже разобрался))..Исправил на:
Sheets("Лист1").Select
Range("I6:I8").Select
Selection.Font.ColorIndex = 10

CEMEH
Pravoved90
dneprcomp
ребята, спасибо за отклик, буду думать, как лучше, конечно все таки хотелось сделать макросом.

q1wed

Цитата:

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

Был бы очень признателен

mistx
Да делай хоть макросом, хоть процедурой... Все равно надо будет применять те функции, что я привел.
PS. Макрос не является чем то самостоятельным. Он просто об'единяет в себе код. Как bat файл, к примеру.

Цитата:

[/q]
[q]Workbooks("тратата.xls").Close savechanges = False перед закрытием показывает сообщение: в буфере обмена содержится большой формат данных... как избавиться от появления этого сообщения?
Application.DisplayAlerts = False: Workbooks("тратата.xls").Close - эксель сразу виснет

Я испытывал такое же неудобства до того, пока не поставил ПЕРЕД закрытием такой оператор
Application.CutCopyMode = False
Вопросы у системы пропали разом.

mistx нашел я файл, вот он, на одном листе вариант с макросом на другой без. Буквы "О" не ставит - это сам переделывай. Вот код:
Код: Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("a1:b1")) Is Nothing Then
Dim i As Integer
Dim dt As Date
For i = 2 To 32
On Error GoTo errorhandler
dt = Cells(2, i).Text + "-" + Cells(1, 2).Text + "-" + Cells(1, 1).Text
Cells(3, i).Value = dt
If Weekday(dt, vbMonday) = 7 Or Weekday(dt, vbMonday) = 6 Then
Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(115, 160, 245)
Else
Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(255, 255, 255)
End If
Select Case Weekday(dt, vbMonday)
Case 1
Cells(4, i) = "Пн."
Case 2
Cells(4, i) = "Вт."
Case 3
Cells(4, i) = "Ср."
Case 4
Cells(4, i) = "Чт."
Case 5
Cells(4, i) = "Пт."
Case 6
Cells(4, i) = "Сб."
Case 7
Cells(4, i) = "Вс."
End Select
Nextvalue:
Next
End If
Application.EnableEvents = True
Exit Sub
errorhandler:
Range(Cells(3, i), Cells(12, i)).Interior.Color = RGB(185, 185, 185)
Range(Cells(3, i), Cells(12, i)).ClearContents
Resume Nextvalue
End Sub

Доброго всем времени суток!
У меня вопрос по Excel 2007. Есть макрос в личной книге макросов. Есть кнопка на панели быстрого доступа. Все вроде бы замечательно, но если Excel запустить без личной книги макросов (путем вызова из другой программы), то кнопка не срабатывает, выдает сообщение об ошибке "400". В старых версиях офиса при нажатии на кнопку с привязанным к ней макросом, погружалась личная книга макросов и все было замечательно. Что здесь можно сделать?

Доброе утро!
Подскажите такой простой вопрос:
Как на форму добавить метку? Можно ли это сделать без кода... вручную...
вообще как правильно это делать? СПС

Добрый день.

Подскажите, можно ли как-то в VBA сделать проверку данных в ячейке по определённому формату?

Например, хочу чтобы в ячейку можно было ввести текст из 4 букв и 6 цифр. Если 5 цифр или 4 буквы, то выскакивает эрор.

Заранее спасибо.

nopoxz
Используй оператор Like

SAS888

Да, я уже поковырялся с этим Like. Чтобы получилось написать код, надо знать, что означают символы "" " ? # * [] и т.д.

Есть места, где об этом написано?

Приветствую, многоуважаемые!
Уже понял, что хочу изучить VB, но категорически нет времени Надо решить одну задачу.Ссори за возможный повтор...или может дадите ссылку нужную.

есть файл1 - там ежедневная статистика в утвержденной форме.В ячейке B1=дата.
Есть файл2 - состоит из файлов1(на 1 worksheetе),т.о. образует календарный месяц.Там есть всякие сложные формулы и разные суммы.форма тоже утверждена.в ячейке B5=дата.

Задача: сделать макрос, чтобы данные из определенных ячеек файла1 автоматом вставлялись в соответствующие ячейки файла2, ПРИ условии что ячейка B1 файла1=B5 файла2,т.е. чтобы данные подставлялись в одни и те же заранее установленные ячейки, но в нужную дату в файл2).

Пока вот такая вот проблемка...

nopoxz

в хелпе написано

Characters in pattern Matches in string

Tormozilka2000
Думаю, надо капать в этом направлениии
If [файл1!B1] = [файл2!B5] Then
[файл3!C1] = [файл3!C5]
(возможно другие варианты написания диапозонов)

Pravoved90
Дык вот...никак

Sub CopyRange()
If Workbooks("everyday.xls").Sheets("Sheet1").Range("B1").Value = Workbooks("monthly.xls").Sheets("Daily Loans Outs Actual").Range("B5").Value Then
Workbooks("everyday.xls").Sheets("Sheet1").Range("B6:B8", "B10:B12").Copy
Workbooks("monthly.xls").Sheets("Daily Loans Outs Actual").Range("B39:B41", "B43:B45").PasteSpecial Paste:=xlPasteValues
End If
End Sub

Что не так?

Благодарю за отклик.

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

Вот рабочий пример(записывай его в модуле, НЕ в листе)

Sub Макрос1()

If Sheets("Лист1").Range("D1").Value = Sheets("Лист1").Range("D2").Value Then
Sheets("Лист2").Range("С2").Value = Sheets("Лист1").Range("А10").Value
End If
End Sub



Добавлено:
Люди, подскажите, как сделать примерно такое:
Если значение в ячейке не совпадает с любым из значений, заданных в выпадающий список для этой ячейки(такое возможно, если значение в ячейку копируешь из другой), - занесенное значение = 0(или удалялось).

И еще. Есть ли функция для определения, совпадают ли значения в ячейках с заданными в них значениями из выпадающего списка?Спасибо

q1wed
Спасибо огромное.

dneprcomp
q1wed

с формулами просто супер, недооценивал я раньше функцию Деньнед
признаться честно даже не знал, что с ней такое можно вытворять

Здравствуйте. У меня задача сделать макрос, который будет вызывать форму для заполнения таблицы. С задачей сделать форму для заполнения таблицы я справился. Но вот как привязать каждое поле ввода к конкретному столбцу и что бы после заполнения полей и нажатия кнопки ОК данные появлялись в таблице я не смог. Подскажите примерами.

Pravoved90

Цитата:

Люди, подскажите, как сделать примерно такое:
Если значение в ячейке не совпадает с любым из значений, заданных в выпадающий список для этой ячейки(такое возможно, если значение в ячейку копируешь из другой), - занесенное значение = 0(или удалялось).

Если список выпадающих значений задан диапазоном ячеек листа, то Вашу задачу можно решить, вставив в модуль соответствующего листа следующий код:

Код: Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As Range, y As Range, z As Range
Application.EnableEvents = False
Set z = [B1] 'Адрес контролируемой ячейки с выпадающим списком
Set y = [A1:A4] 'Диапазон значений выпадающего списка
If Target.Address = [B1].Address Then
Set x = y.Find(Target, LookAt:=xlWhole)
If x Is Nothing Then
[B1] = 0
With [B1].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=" & y.Address
End With
End If
End If
Application.CutCopyMode = False
Application.EnableEvents = True

End Sub

Разобрался с тем как добовлять в ячейки данные из формы.
использовал этот код

Код:
Private Sub CommandButton1_Click()
NextRow = Application.WorksheetFunction.CountA(Range("A:A")) + 1
Cells(NextRow, 1) = UserForm1.TextBox1.Text
Cells(NextRow, 2) = UserForm1.TextBox2.Text
Cells(NextRow, 3) = UserForm1.TextBox2.Text

' Очистка элементов управления для следующих записей
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
OptionUnknown = True
TextBox1.SetFocus
End Sub