» Excel VBA (часть 2)

AndVGri

Цитата:

Это где, в Excel? Такого события там нет. Если это в VB, то ты перепутал раздел, да и в этом случае обработчик события UserForm1_Hide. В Excel UserForm1.Hide - команда форме на её скрытие. На "крестик" же обработчик UserForm_Terminate

Я просто не так выразился ....я и имел ввиду UserForm1.Hide ,как команду на скрытие,т.е.я присвоил эту команду кнопке на форме.

Цитата:

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

так я же и написал
Цитата:

Прописываю в каждом переключателе на
Событии «Клик» такой код : Range ("A1").Value = "1"во втором Range ("A1").Value = "2"
В третьем Range ("A1").Value = "3" ну и т.д.на других фреймах

Загружаю форму щёлкаю преключатели .несколько раз пощёлкаю и всё зависает.
Цитата:

Тогда стоит ли заниматься программированием?

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


Добавлено:
AndVGri

Ещё один вопрос.Как запретить пользователю добавлять панели инструментов?
Помоги если не трудно
нашёл вот такой код CommandBars("Toolbar List").Enabled = False
но он запрещает только контекстное меню ,но на панели имеется скажем так треугольничек,который открывает меню добавления . Нельзя его как-то запретить или убрать.

GFSGF

Цитата:

Как запретить пользователю добавлять панели инструментов?

Где-то так, хотя не совсем корректно
[more]
Для защиты от изменений панелей предлагается следующий макрос ShieldPanels. Работать пользователь сможет только через меню Excel и контекстные меню. При желании, можешь разобраться с кодом и какие-то панели оставить.

Код:
Private Sub ShieldCustomize(ByVal pControls As CommandBarControls)
Dim pControl As CommandBarControl

If pControls Is Nothing Then Exit Sub
For Each pControl In pControls
If InStr(1&, pControl.Caption, "Настройка...", vbTextCompare) > 0& Then
pControl.Enabled = False
End If
If InStr(1&, pControl.Caption, "Панели &инструментов", vbTextCompare) > 0& Then
pControl.Enabled = False
ElseIf TypeOf pControl Is CommandBarPopup Then
ShieldCustomize pControl.Controls
End If
Next pControl
End Sub

Public Sub ShieldPanels()
Dim pBar As CommandBar
Dim pItem As CommandBarControl

For Each pBar In Application.CommandBars
If (pBar.Name <> "Worksheet Menu Bar") And _
(pBar.Type <> msoBarTypePopup) Then
pBar.Enabled = False
End If
ShieldCustomize pBar.Controls
Next pBar
End Sub

AndVGri

Цитата:

Так вот и не понятно, в остальных фреймах ячейке А1 присваиваются значения 4..9?

Для второго фрейма: также устанавливаю цифры 1,2,3 но только в ячейку A2
Для третьего фрейма:также устанавливаю цифры 1,2,3 но только в ячейку A3
Я так и писал

Цитата:

Это на первом фрейме.На втором и на третьем фрейме тоже самое, только цифры 1,2 и 3 записываются соответственно в ячейку A2 и A3

Задача пользователя открыть форму ,выбрать в каждом фрейме переключатель и закрыть форму.

Цитата:

Может в процессе поступления данных и работы формы и возникает зависание? А не имеет ли смысл уйти от работы с Excel и написать отдельную программу работы с автолинией?

Зависание происходит на моём компе дома.Он ни кчему не подключен.Я просто пока делаю программу для пользователя. Проблема где-то у меня лично.У меня был прописан код на защиту листа
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection на событие Workbook_Open()
вот я его убрал и пока не зависает.Может что-то было с этим связано?
Использую пока все твои замечания и советы.
Насчёт запрета панелей сейчас попробую. Вообще интересная штука VBA,я к ней что-то раньше серьёзно не относился

GFSGF

Цитата:

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection на событие Workbook_Open()

Ну, вот, а писал, что всё упомянул о своём коде. Насколько я понял, это будет постоянная рабочая книга с защищаемым листом.
Тогда зачем же так? Выделяешь ячейки А1:А3, нажимаешь правую клавишу, в контекстном меню выбираешь "Формат ячейки", вкладка "Защита", сбрасываешь флажок "Защищаемая ячейка". Далее, в меню Сервис/Защита/Защитить лист.. - выбираешь нужные параметры (те, что у тебя записаны в макросе) задаёшь пароль и всё. Ячейки А1:А3 будут доступны программно и не нужно будет каждый раз устанавливать защиту - лишнее.
По идее, Excel должен был сразу у тебя ругаться на попытку изменить защищённые ячейки.
Если не секрет - зачем так ограничивать пользователей аж до не возможности настроить Excel под себя?

Люди, ламерский вопрос, не корите, только учусь, подскажите, что нужно добавить, чтобы этот макрос работал не на весь лист, а обраватывал только конкретный диапазон строк например с 25-й по 64ю.

i = 4
Sum = 0
Do While Cells(i, 2) <> ""
razn = 192 - Sum
If Cells(i, 3) < razn Then
Sum = Sum + Cells(i, 3)
ElseIf Cells(i, 3) > razn Then
Rows(i + 1).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Cells(i + 2, 1) = Cells(i, 1)
Cells(i + 2, 2) = Cells(i, 2)
Cells(i + 2, 3) = Cells(i, 3) - razn
Cells(i, 3) = razn
i = i + 1
Sum = 0
ElseIf Cells(i, 3) = razn Then
Rows(i + 1).Select
Selection.Insert Shift:=xlDown
i = i + 1
Sum = 0
End If
i = i + 1
Loop

prosims
С 25 понятно i = 25 в место i = 4. А вот с 64. Это какая строка? Считая с исходного состояния? Или пока i = 64, учитывая то, что у тебя производится вставка строк?

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

Sub four()
ReDim a(6)
For i = 1 To 6
Next i
L=10

End Sub
а что дальше? cells(1,1) прибавить какое-то число и a(i)=a(i)+1? и эти значения вывести на экран?

допустим у нас есть
a(0)=2
a(1)=3
a(2)=4
a(3)=5
a(4)=6
a(5)=7
а L=3
первый элемент больше 3 это a(2), а как тока этот один элемент вывести на печать?
вот что я набросал:
Sub four()
ReDim a(6)
i = 0
L = 3
For i = 1 To 6
Next i
If a(i) > L Then i = i + 1
.........
MsgBox ("Таких чисел " & i & " это число " &...)
End If
End Sub


Добавлено:
тока там
i = 1

AndVGri

Цитата:

Насколько я понял, это будет постоянная рабочая книга с защищаемым листом.

Да ты правильно понял.
Цитата:

Если не секрет - зачем так ограничивать пользователей аж до не возможности настроить Excel под себя?

Потому что в эксел пойдут данные о работе оператора линии за его смену,т.е.сколько продукции он выпустил.от этого будет зависеть его заработная плата,поэтому я хочу максимально защитить лист и убрать все панели инструментов и меню добавления,чтобы он не мог изменить эти данные.Кстати коды по панелям я проверил .всё прекрасно работает,проблема с разблокировкой такая же как у тебя было написано,но это не страшно.
Цитата:

По идее, Excel должен был сразу у тебя ругаться на попытку изменить защищённые ячейки.

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


Цитата:

Тогда зачем же так? Выделяешь ячейки А1:А3, нажимаешь правую клавишу, в контекстном меню выбираешь "Формат ячейки", вкладка "Защита", сбрасываешь флажок "Защищаемая ячейка". Далее, в меню Сервис/Защита/Защитить лист.. - выбираешь нужные параметры (те, что у тебя записаны в макросе) задаёшь пароль и всё. Ячейки А1:А3 будут доступны программно и не нужно будет каждый раз устанавливать защиту - лишнее.

ты прав я что-то об этом сначала не подумал.сейчас пожалуй переделаю

Всем привет!! есть вопросик:
нужен код на кнопку чтобы при нажатии выделялся диапазон ячеек от курсора
вниз на 10 строк но не полных а например на 20 столбцов
Заранее спасибо

Zeerax
Range(ActiveCell, ActiveCell.Offset(10&, 20&)).Select

GFSGF

Цитата:

от этого будет зависеть его заработная плата

Щелчёк влево, щелчёк вправо - лишение зарплаты
Тогда тебе в эту книгу необходимо встроить защиту от закрытия. Событие книги
Workbook_BeforeClose(Cancel As Boolean) позволяет по Cancel = True запретить закрытие книги. Можно задать пароль для проверки права на закрытие. Создаёшь форму для ввода пароля, которая вызывается в этом событии. Для TextBox формы устанавливаешь свойство PasswordChar (например классическая *). В самой книге создай скрытый рабочий лист, где, как раз, можно хранить и настройки и пароль на закрытие книги. Да и сам VBAProject защити паролем

САМ СПРОСИЛ - САМ И ОТВЕЧАЮ!
[more]
P.S буду признателен если кто-нибудь оптимизирует код

'******************************************************************************************************************************
'Функция копирования данных из разных файлов, из разных таблиц в одну *
'****************************************************************************************************************************** *
' FileName - имя файла с таблицей (файл должен быть открыт), *
' Sheet_Number - номер листа *
' Kolonka - номер колонки *
' Schetchik - счетчик (с какой ячейки надо просматривать), *
' KOF - коээфициент (в него передаётся с какой ячейки нужно продолжать ' вставку данных из другого источника) *
'******************************************************************************************************************************

Function Zalivka(FileName As String, Sheet_Number As Integer, Kolonka As Integer, Schetchik As Integer, KOF As Integer)
Dim Minus As Integer

If Schetchik = 14 Then
Minus = 14
End If

If Schetchik = 16 Then
Minus = 16
End If

If Schetchik = 17 Then
Minus = 17
End If

If Schetchik = 19 Then
Minus = 19
End If

'запускаем цикл по строкам (число 200 м.б. любым)
For i = Schetchik To 200

'проверяем, если текущая ячейка не пуста
If Workbooks(FileName).Worksheets(Sheet_Number).Cells(i, Kolonka).Value <> "#" Then

'то копируем данные из указанного источника в данную книгу, на текущую страницу
Workbooks("rpt_result.xls").Worksheets(Sheet_Number).Cells(i + KOF, Kolonka).Value = Workbooks(FileName).Worksheets(Sheet_Number).Cells(i, Kolonka).Value

'если натыкаемся на пустую ячейку
Else

'то вычисляем позицию с которой будем продолжать копировние и выходим из цикла
KOF = i - Minus + KOF
Exit For
End If
Next i

End Function

'******************************************************************************
'применяем ф-цию *
'******************************************************************************

Sub Mac()
Dim Schetchik, KOF As Integer
Dim i As Integer
Dim g As Integer
Dim f As Integer

Dim FileName As String

'******************************************************************************
'копируем данные *
'******************************************************************************
KOF = 0

Dim arr(5) As String
arr(1) = "rpt_10.xls"
arr(2) = "rpt_31.xls"
arr(3) = "rpt_33.xls"
arr(4) = "rpt_43.xls"
arr(5) = "rpt_48.xls"

Dim arrn(10) As Integer
arrn(1) = 16 'номер листа и строки
arrn(2) = 16
arrn(3) = 16
arrn(4) = 16
arrn(5) = 14
arrn(6) = 19
arrn(7) = 17
arrn(8) = 17
arrn(9) = 17
arrn(10) = 14


For g = 1 To 10
For f = 1 To 16
KOF = 0
For i = 1 To 5
a = Zalivka(arr(i), g, f, arrn(g), KOF)
'файл, лист, колонка
Next i
Next f
Next g
End


End Sub
[/more]

Такая проблемка, есть следующий программный код:
Private Sub Vip1_Click()
Dim i As Long
Dim y As Integer
Dim pEG As Worksheet

Set pEG = Sheets("&#197;&#230;&#229;&#228;&#237;&#229;&#226;&#237;&#224;&#255; &#241;&#226;&#238;&#228;&#234;&#224;")
pEG.Activate
Range("A3:H100").Select
Selection.ClearContents

y = 3
For i = 3 To 65536

If txt.Text = Sheets("1").Cells(i, 6).Value _
Or txt.Text = Sheets("1").Cells(i, 7).Value _
Or txt.Text = Sheets("1").Cells(i, 8).Value Then

For colindex = 1 To 8
Sheets("2").Cells(y, colindex).Value = _
Sheets("1").Cells(i, colindex).Value
Next colindex
y = y + 1
End If
Next i

EgednSvodka.txt.Text = ""
EgednSvodka.Hide

End Sub

Как теперь заставить выделить тот диапазон, который был скопирован?

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

Private Sub CommandButton1_Click()
Dim pSource As Worksheet, pDest As Worksheet
Dim i As Long, vFirst As Long, vLast As Long, vFirstCol As Long
Dim vBegin As Date, vEnd As Date, vCode As Long
Dim vCurrent As Date, vPos As Long
Dim x As Long
Dim y As Integer

y = 3


vBegin = CDate(TextBeginYear1.Text)
vEnd = CDate(TextEndYear1.Text)

Set pSource = Sheets("&#195;&#235;&#224;&#226;&#237;&#224;&#255;")

Set pDest = Sheets("V1")

pDest.Activate
Range("A3:H10000").Select
Selection.ClearContents

pSource.Activate

For i = 3 To 65536
vCurrent = CDate(pSource.Cells(i, 6).Value)
If (vCurrent >= vBegin) And (vCurrent <= vEnd) Then
vPos = vPos + 1&
For colindex = 1 To 6
Sheets("V1").Cells(y, colindex).Value = _
Sheets("&#195;&#235;&#224;&#226;&#237;&#224;&#255;").Cells(i, colindex).Value
Next colindex
y = y + 1
End If
Next i
TextBeginYear = ""
TextEndYear = ""
DiapazonV1.Hide
End Sub

Но выдает ошибку, ругается на наличие формул в столбце, как заставить его игнорировать формулы, а брать только ячейки со значением?

Помогите, пожалуйста, и Россия вас не забудет)))

GrustniyPanda
[
Цитата:

Как теперь заставить выделить тот диапазон, который был скопирован?

Sheet("2").Activate
Range(Cells(3,1), Cells(Cells(y-1, 8)).Select

Цитата:

Но выдает ошибку, ругается на наличие формул в столбце

В столбце формула массива с {}

AndVGri


Цитата:

Sheet("2").Activate
Range(Cells(3,1), Cells(Cells(y-1, 8)).Select

Пасибо большое



Цитата:

В столбце формула массива с {}

Надо чтобы формулы считали, но при запросе они игнорировались

GrustniyPanda

Цитата:

Надо чтобы формулы считали, но при запросе они игнорировались

Подробнее. Пока видно, что у тебя идёт копирование данных с листа на лист. Где и причём тут формулы?

AndVGri

Цитата:

Подробнее. Пока видно, что у тебя идёт копирование данных с листа на лист. Где и причём тут формулы?

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

GrustniyPanda
Проход по всем ячейкам первого столбца, не содержащим формулы:

Код: For each Cell in Columns(1).SpecialCells(xlCellTypeConstants)
...
Next Cell

Что можно изменить в коде, макрос слишком долго выполняется
(строк бывает от 500 до 1500)?


Код: Private Sub Макрос()
Application.ScreenUpdating = False
Dim r As Long, LastRow As Long
LastRow = Range("B65536").End(xlUp).Row
For r = 9 To LastRow
Range(Cells(r, 10), Cells(LastRow, 10)).FormulaR1C1 = _
"=INDEX([Книга1.xls]Лист1!R1C1:R3500C8,MATCH(RC2,[Книга2.xls]Лист1!R1C2:R3500C2,0),7)"
Next r
Range(Cells(9, 10), Cells(LastRow, 10)).Copy
Cells(9, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("J1").Select
End Sub

The okk
Напиши, пожалуйста, поподробней, так выдает ошибку: "не найдено ни одной ячейки, удовлетворяющие условию", хотя там и забиты даты.

GrustniyPanda
Вопрос о формуле массива касается листа, куда копируются данные, то есть:

Цитата:

Sheets("V1").Cells(y, colindex).Value

aks_sv

Цитата:

For r = 9 To LastRow
Range(Cells(r, 10), Cells(LastRow, 10)).FormulaR1C1 = _
"=INDEX([Книга1.xls]Лист1!R1C1:R3500C8,MATCH(RC2,[Книга2.xls]Лист1!R1C2:R3500C2,0),7)"
Next r

А просто

Код:
Range(Cells(9, 10), Cells(LastRow, 10)).FormulaR1C1 = _
"=INDEX([Книга1.xls]Лист1!R1C1:R3500C8,MATCH(RC2,[Книга2.xls]Лист1!R1C2:R3500C2,0),7)"

AndVGri

Цитата:

Range(Cells(9, 10), Cells(LastRow, 10)).FormulaR1C1 = _
"=INDEX([Книга1.xls]Лист1!R1C1:R3500C8,MATCH(RC2,[Книга2.xls]Лист1!R1C2:R3500C2,0),7)"

Спасибо! Как сам недодумался?? ;((

AndVGri
Вопрос о формуле массива касается листа, куда копируются данные, то есть:

Цитата:Sheets("V1").Cells(y, colindex).Value [/q]

А поподробнее можешь? )))

GrustniyPanda
Выложи файлы с данными, тогда и поподробнее и детальнее и обстоятельнее и...

AndVGri
Есть столбец, там забиты следующие формулы =ЕСЛИ(F3<>0;ДАТА(ГОД(F3);МЕСЯЦ(F3)+1;ДЕНЬ(F3));""), и так до конца, так же в столбцах забиты и просто дата в таком формате 01.01.2007, надо чтобы запросик отбирал только значения с датами (не трогая формулы) по периоду с такого то по такой, у меня получился следующий код:

Private Sub CommandButton1_Click()
Dim pSource As Worksheet, pDest As Worksheet
Dim i As Long, vFirst As Long, vLast As Long, vFirstCol As Long
Dim vBegin As Date, vEnd As Date, vCode As Long
Dim vCurrent As Date, vPos As Long
Dim x As Long
Dim y As Integer
Dim b As Long

y = 3

If TextEndYear.Text = "" Or TextBeginYear.Text = "" Then
a = MsgBox("Заполните все поля")
Exit Sub
End If

vBegin = CDate(TextBeginYear2.Text)
vEnd = CDate(TextEndYear2.Text)

Set pSource = Sheets("Главная")

Set pDest = Sheets("V2")

pDest.Activate
Range("A3:H100").Select
Selection.ClearContents


b = Sheets("Главная").Cells(3, 1).CurrentRegion.Rows.Count
For i = 3 To b
vCurrent = CDate(pSource.Cells(i, 7).Value)
If (vCurrent >= vBegin) And (vCurrent <= vEnd) Then
vPos = vPos + 1&
For colindex = 1 To 5 And 7
Sheets("V2").Cells(y, colindex).Value = _
Sheets("Главная").Cells(i, colindex).Value
Next colindex
y = y + 1
End If
Next i

Next Cell

TextBeginYear = ""
TextEndYear = ""
DiapazonV2.Hide
End Sub

Здраствуйте
Подскажите что сдеcь не так:

Код:
Sub limity_zap()
Sub limity_zap()
vfirst = ActiveSheet.UsedRange.Row
last_col = vfirst + ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To last_col
If Cells(i, 2).Value = "2-&eacute; &ecirc;&acirc;&agrave;&eth;&ograve;&agrave;&euml;" Then start_kv = i + 3
If Cells(i, 2).Value = "3-&eacute; &ecirc;&acirc;&agrave;&eth;&ograve;&agrave;&euml;" Then kin_kv = i - 3
Next i
'MsgBox (kin_kv)
For i = start_kv To kin_kv
For t = 1 To 4444
t = Application.ThisWorkbook.ActiveSheet.Cells(i, 9).Value
t1 = Mid(t, 1, 3)
t2 = Mid(t, 5, 2)
t3 = Mid(t, 8, 2)
x = (t1) & (t2) & (t3)
x = Trim(x)
If x = Application.Workbooks("UMC_04.2007").Worksheets("Sheet1").Cells(t, 4) Then _
Application.ThisWorkbook.ActiveSheet.Cells(i, 15).Value = Application.Workbooks("UMC_04.2007").Worksheets("Sheet1").Cells(t, 7).Value
Next t
Next i

GrustniyPanda
Книгу с листом "V2" выложить проблема? Ругается VBA, скорее всего, на

Цитата:

Selection.ClearContents

Поскольку там, возможно, находится часть формулы массива. Формула массива может быть удалена только полностью.
А вот это

Цитата:

Next Cell

к какому циклу у тебя относиться?

hackman
Один из выводов теории алгоритмов гласит: не существует такого алгоритма, который по тексту программы мог бы определить, что эта программа делает.

Цитата:

For t = 1 To 4444
t = Cells(i, 9)

С чего ты решил, что можно изменять переменную цикла внутри тела цикла? Ты уверен, что цикл по t выполниться 4444 раза? Или это так, от безысходности?

Исправил но ошибка есть (Subscript is out of Range). 4444. ето число рядов у файле UMC_04.2007ю


Код:
Sub limity_zap()
vfirst = ActiveSheet.UsedRange.Row
last_col = vfirst + ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To last_col
If Cells(i, 2).Value = "2-&eacute; &ecirc;&acirc;&agrave;&eth;&ograve;&agrave;&euml;" Then start_kv = i + 3
If Cells(i, 2).Value = "3-&eacute; &ecirc;&acirc;&agrave;&eth;&ograve;&agrave;&euml;" Then kin_kv = i - 3
Next i
'MsgBox (kin_kv)
For i = start_kv To kin_kv
For t = 1 To 65000
p = Application.ActiveWorkbook.ActiveSheet(i, 9)
t1 = Mid(p, 1, 3)
t2 = Mid(p, 5, 2)
t3 = Mid(p, 8, 2)
x = (t1) & (t2) & (t3)
x = Trim(x)
If x = Application.Workbooks("UMC_04.2007").Worksheets("Sheet1").Cells(t, 4) Then _
Application.ThisWorkbook.ActiveSheet.Cells(i, 15).Value = Application.Workbooks("UMC_04.2007").Worksheets("Sheet1").Cells(t, 7).Value
Next t
Next i

End Sub

hackman

Цитата:

p = Application.ActiveWorkbook.ActiveSheet(i, 9)

Может ты имел в виду?

Код:
p = Application.ActiveWorkbook.ActiveSheet.Cells(i, 9)

AndVGri
Я послал на ящик архив с файлом. Selection.ClearContents вряд ли, так как лист V2 пустой, там только шапка висит. Спасибо за помощь.