» Excel VBA (часть 2)

Народ, помогите пож.
На форме нужно отобразить календарный план работы сотрудников (т.е. по столбцы - это дни месяца с 1 по 31, строки - это сами сотрудники + нужно редактирование каждой ячейки, а не так как в ListView). Нарыл в инете решение - datagrid. Но при его установке вба ругается - субъект не имеет доверия для выполнения указанного действия. Что надо прописать и где?????
Или посоветуйте пожалуйста другое решение, как эту задачу можно организовать..
----
d:\WINDOWS\system32\MSDATGRD.OCX
скопал сюда, потом зарегистрировал. Версия 6.0.81.69

liatera
Метод Select без особой необходимости старайтесь не применять. Это, как правило, излишество. Вашу задачу
Цитата:

сделать цикл от "координата клетки" до "нуля".

можно решить, например, так:

Код: Sub Main()
Dim i As Long, j As Long: Application.ScreenUpdating = False
j = ActiveCell.Column
For i = ActiveCell.Row To 2 Step -1
Rows(i & ":" & i + 1).Insert: Cells(i, j) = "data": Cells(i - 1, j) = "[Net.=" & Cells(i - 1, j) & "]"
Next
End Sub

Кто хорошо разбирается в FSO подскажите скрипт для работы с размерами файлов, возникла такая задача.
Есть на диске около 20 папок, по 500 файлов в каждой. Имена файлов совпадают (500 наборов из 20 одинаковых имён) но сами файлы с разными размерами. Требуется отобрать файлы по определённому критерию - а именно по размеру, чтоб из каждой двадцатки остался один. Выбрать нужно файл с максимальным размером, не превышающим 5000000 байт, остальные удалить, или переместить такие файлы в одно место. Кстати размеры файлов в наборе иногда могут совпадать, в этом случае оставляем первый попавшийся. Если это слишком заморочно - тогда просто выбрать наименьший из 20

SAS888 - респект. большое спасибо.

ответ на вопрос из темы "Excel FAQ"

nidhthunter

Цитата:

Господа, подскажите в такой проблеме:
есть у книге листы с именами, которые (имена) потом собраны на одном листе. как через VBA сделать ссылки на эти листы?

можно такое сделать [more=макросом]
Код:
Sub SheetList()
Dim sheet As Worksheet
Dim cell As Range
With ActiveWorkbook
For Each sheet In ActiveWorkbook.Worksheets
Set cell = Worksheets(1).Cells(sheet.Index, 1)
.Worksheets(1).Hyperlinks.Add anchor:=cell, Address:="", SubAddress:="'" & sheet.Name & "'" & "!A1"
cell.Formula = sheet.Name
Next
End With
End Sub

crotoff
Задача, в общем-то, не сложная. Требуются уточнения.
1. Должен быть какой-то xls-файл, из которого будет запускаться данная процедура? Или как?
2. Где находятся эти 20 папок и по каким признакам их искать? Может быть они в одной папке? Есть ли в ней еще папки, которые не нужны для обработки? Если они в разных местах, то по каким признакам их выбирать?
3. Куда девать выбранные файлы?

SAS888
это непринципиально
1. можно xls с макросом (привычнее) можно vbs скриптом
2. 20 папок предположим, c:\01\ .... c:\20\
файлы в них предположим для удобства от 001.txt до 500.txt (переименовать недолго если что), вообще-то называются они причудливо, но все буквы в названиях латинские
3. результат можно вывести в виде списка в txt с полными путями, а можно переместить сами файлы в c:\21\

ЗЫ или для наглядности просто вывести в текущий xls - по строчкам наименования файлов, по столбикам - размеры в каждой папке, а дальше уж критерий задать и команды для батника - дело техники

SAS888

Цитата:

можно решить, например, так:

спасибо огромное. очень просто и эффективно.

Еще один вопрос.
Есть форма. На ней например 5 меток. (label)
Как сделать ОДНО событие в коде для всех меток?

Например для одной метки

Код:
Private Sub Label57_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
msgbox "1"
End Sub

создайте функцию на форме и вызывайте ее в каждом обработчике события Click для формы

Цитата:

создайте функцию на форме и вызывайте ее в каждом обработчике события Click для формы

угу, так и сделал((
выход корявый, но хоть такой
спс

V4mp

Цитата:

выход корявый

Да уж, не лучший. Создайте модуль класса и в нем пропишите требуемую процедуру.
Например, Так.

SAS888

Цитата:

Цитата:выход корявый

Да уж, не лучший

Просто искренне стало интересно почему не лучший и корявый?

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

crotoff
Посмотрите пример Здесь.
Все папки, в которых нужно провести поиск файлов, могут иметь любое имя, но находиться в 1-й папке. В примере это "C:\TMP". Запустите макрос "Main". В результате, на рабочем листе будет создан список файлов, их размеров и путей по Вашим требованиям. Так же, эти файлы будут скопированы в отдельную папку. В примере это "C:Elected". В коде макроса пропишите свои пути к исходной папке и папке для копирования выбираемых файлов (там есть соответствующие комментарии).

SAS888
Вроде работает, но в список на лист выводятся и копируются в Elected только файлы из первого подкаталога вне зависимости от размера. Как бы вывести в таблицу содержимое всех подкаталогов?

crotoff

Цитата:

на лист выводятся и копируются в Elected только файлы из первого подкаталога вне зависимости от размера

1. Не правда. Я проверял. Распакуйте Этот архив в "C:\" и запустите макрос "Main" из файла "ExtractFiles.xls". Посмотрите результаты на листе и в папке "C:\Elected". Обратите внимание на пути и размеры полученных файлов.
2. Что Вы хотите видеть на листе Excel-файла и в каком виде?

SAS888
1. В Вашем примере все файлы имеют размер меньше 5000000 байт, а в макросе почему-то условие сравнения с 5000000 не срабатывает

Имя файла     Размер файла     Полный путь
DSC00014.JPG    11008185    C:\Temp\temp\1\DSC00014.JPG

в каталогах 2 и 3 есть файл DSC00014.JPG - размер файла меньше 5000000, но выбирается из первого

2. как вывести в Excel полный список содержимого подкаталогов в таком же виде (Имя файла     Размер файла     Полный путь) ?



Добавлено:
по второму вопросу уже подсказали - оказывается в TC можно скопировать содержимое колонок, задав для выделенных папок вид "показывать все файлы без подкаталогов", правда при экспорте в Excel размеры получаются с пробелами-разделителями групп разрядов

SAS888

Цитата:

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

Не заметил, что они функцию к form_click привязали
Вызов то надо поместить на click каждого нужного объекта.

Приветствую
Вероятно есть всяческие готовые модули для статистикики, подскажите, где найти или как сделать следующее.
Нужен расчет коэффициентов уравнения по экспериментальным данным. На всякий описал что нужно в файле: http://www.onlinedisk.ru/file/207140/

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

SAS888

Цитата:

Да уж, не лучший. Создайте модуль класса и в нем пропишите требуемую процедуру.
Например, Так.

Спасибо огромное!
Это как раз то, что нужно.
Минимум строк кода, и не нужно писать обработчик для каждого события метки.
dneprcomp

Цитата:

Просто искренне стало интересно почему не лучший и корявый?

Объясню почему.
У меня порядка 300 меток на одной закладке формы (импровизированный календарный план, который 100% запустится на любой машине). И писать для всех них отдельные обработчики событий даже с 1 функцией вызова - это конечно .... по мне)
SAS888 подсказал отличное решение, спс еще раз.

crotoff

Цитата:

по второму вопросу уже подсказали...

А по первому вопросу, действительно, у меня был "косяк". Дело в том, что если имя файла уже есть в списке, тогда контролируется размер. А если такого файла еще не было (как раз в случае обработки первого подкаталога), то файл заносился в список без контроля размера.
Возьмите [more= исправленный ]
Код: Sub Main()
Dim fso, SubF As Object, myPath As String, myName As String, x As Range, myFolder As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Cells.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
[A1] = "Имя файла": [B1] = "Размер файла": [C1] = "Полный путь"
myPath = "C:\TMP" 'Подставьте свой путь к папке
For Each SubF In fso.GetFolder(myPath).SubFolders
myName = Dir(SubF.Path & "\*")
Do While myName <> ""
Set x = [A:A].Find(what:=myName, LookAt:=xlWhole)
If x Is Nothing Then
If fso.GetFile(SubF.Path & "\" & myName).Size <= 5000000 Then _
Exec Cells(Rows.Count, 1).End(xlUp).Row + 1, SubF.Path, myName
ElseIf fso.GetFile(SubF.Path & "\" & myName).Size > Cells(x.Row, 2) And _
fso.GetFile(SubF.Path & "\" & myName).Size <= 5000000 Then
Exec x.Row, SubF.Path, myName
End If
myName = Dir
Loop
Next
If Cells(2, 1) = "" Then Exit Sub
myFolder = "C:\Elected" ' Путь и имя папки с выбранными файлами. Подсавьте свой.
On Error Resume Next: fso.GetFolder(myFolder).Delete: On Error GoTo 0: MkDir Path:=myFolder
For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row: FileCopy Cells(j, 3), myFolder & "\" & Cells(j, 1): Next
End Sub

Private Sub Exec(i As Long, p As String, f As String)
Dim fso, j As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Cells(i, 1) = f: Cells(i, 2) = fso.GetFile(p & "\" & f).Size: Cells(i, 3) = p & "\" & f
End Sub

SAS888
спасибо! Конструкции сложноваты для меня, попробую разобраться

metrim
уравнение подобрать под точки?
...интересно, если чисто через Excel
Я раньше через Origin считал, но у меня были единичные данные. Там кстати можно выгружать в Excel, и взаимодействовать через ADO.
Datafit - попроще выглядит

metrim
А линия тренда не подходит? она задает уравнение и коэффициенты есть, единственное, точности явно не достаточно, и как ее улучшить я не нашла, поэтому коэффициенты подбираю в Grapher.

Линия тренда не подходит, т.к. там расчет производится по уровнению y=b*exp(mu*x), а мне нужно y=A+b*exp(mu*x).
Кроме того, существует множество алгоритмов апроксимации и хотелось бы использовать тот который используется в Моде Мейкере 3 (т.к. пржде расчеты проводились в нем и для сопоставимости метод должен оставаться аналогичным)
Есть и еще такая деталь, как я показывал- исследовательский график имеет "рост" и "спад", расчет нужно именно по "росту" проводить, желательно автоматически отбрасывать правую часть. Т.к. график имеет колеблщийся характер, просто проверкой, чо данное значение не меньше предыдущего - не отделаешься.
Кривых нужно обсчитать ОЧЕНЬ много, а проводить муторные подгонки данных (с вырезанием спада) и пр. для расчета всего трех коэффициентов - крайне утомительно.

Хотелось бы иметь возможность кликнуть кнопкой и получить 3 коэффициента по экспериментальным данным.

Я уверен, что эти проблемы уже кто то когда то решал для Экселя, потому ищу.

Добавлено:
Что то и МоделМейкер и Ориджин и ДатаФит - дают разные коэфициенты по одним и тем же данным ))))

На форме есть TextBox. Как сделать, чтобы после ввода текста он сохранялся каким-то образом. Тобиш при передачи фокуса в TextBox выпадает список ранее введеных текстов (как в поисковике Google) где можно выбрать себе любой текст а если его нет то ввести новый.

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

Цитата:

Пусть в столбце "A", начиная с 1-й строки содержатся имена листов в текстовом виде.
Следующий макрос создаст ссылки на ячейку "A1" каждого листа. Причем, если такого листа не существует, то ссылка просто не будет создана.

Код: Sub Main()
Dim i As Long, x As Object: Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next: Set x = Sheets(CStr(Cells(i, 1)))
If Err = 0 Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", _
SubAddress:=Sheets(CStr(Cells(i, 1))).Name & "!A1", TextToDisplay:=Cells(i, 1).Text
Else: On Error GoTo 0
End If
Next
End Sub

leoway
вы хотите чтобы нельзя было копировать формат ячейки защищенного листа, так что ли? Запретите выделение защищенных ячеек.
P.S. менять буфер посредством vba нельзя.

metrim
сколько много вопросов! читайте больше книг и задавайте по одному вопросу.

Цитата:

И попутный вопрос по таким функциям: как сделать так, что бы они вносились в список экселевских функций и прописать для них описания и описания для параметров (как это сделано для встроенных функций)

и попутно ответ ))

Код: Application.MacroOptions _
macro:="ТвояФункция", _
Description:="Описалово", _
Category:=1