» Excel VBA

Здравствуйте! Подскажите, плз!
Задача:
файл 1.xls содержит ячейки закрашенные цветом. Лежит в локальной сети.
файл 2.xls копирует из закрытого 1.xls данные, и обрабатывает.
Так вот не могу найти как анализировать цвет ячейки(вопрос 1), да еще по локальной сети из закрытого файла(вопрос 2).
Т.е. например если красная(1.xls), то вставить значение "1"(2.xls), а если синяя(1.xls), то значение "2"(2.xls).

aar
спасибо!

filmax

Цитата:

анализировать цвет ячейки

Cells(x, y).Interior.ColorIndex

на одном из листов есть нужная мне информация из которой формируется имя файла
типа #.####_#.####_01.01 2007 г.
Это значение лежит в ячейке и собирается по функции СЦЕПИТЬ

делаю saveas failname:=range("A1").value
EXEL не ругается
сохраняет но когда обращаюсь к папке куда сохраняю вижу что файл то сохранился не верно
если сразу жму на панели сохранить как в окне вижу
что вроде сохранялся файл как '#.####_#.####_01.01 2007 г.'
в общемто файл сохранился но по значку это не EXCEL
но если я его стартую то файл открывается EXCEL

помогите разобраться
и еще перед saveas мне надо что бы EXCEL создал папку имя которой лежит в ячейке#
а уж потом в эту папку сохранялся бы правильно сам файл

AndVGri! Огромное вам спасибо за такую подсказку!!!
Всё работает! А то я уже полез в программирование VBA.
У меня ещё такой вопрос-есть в Exel 2 ячейки, в каждой из которой по формуле (достаточно сложные и громоздкие, поэтому MatCAD отпадает), в каждую из этих формул входит один неизвестный параметр (обозначим его через X). Необходимо подобрать этот параметр таким, чтобы результат двух формул был бы одинаковым. Я так полагаю необходим просто перебор чисел, до достижения условия равенства двух ячеек. Но как это автоматизировать?
Заранее благодарю за помощь в решении проблемы!

evsino
Короче, всё до кучи

Dim SavePath As String
Dim SaveName As String

SavePath = Application.DefaultFilePath
If Mid$(SavePath, Len(SavePath), 1&) <> "\" Then SavePath = SavePath & "\"
SavePath = SavePath & CStr(Range("Ячейка имени папки").Value)

If VBA.Dir(SavePath, vbDirectory) = "" Then VBA.MkDir SavePath

SaveName = CStr(Range("Ячейка имени книги").Value)
If Len(SaveName) < 4& Then
SaveName = SaveName & ".xls"
Else
If UCase$(Mid$(SaveName, Len(SaveName) - 3&, 4&)) <> ".XLS" Then SaveName = SaveName & ".xls"
End If
ActiveWorkbook.SaveAs Filename:=SavePath & "\" & SaveName

Добавлено:
genf

Цитата:

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

Опять же, можно обойтись без программирования. Как пример:
В А1 - начальное приближение Х, в В1 - 1-ую формулу, в С1 - 2-ую формулю, в D1 - =C1-B1. Далее меню Сервис-"подбор параметра", в диалоге ставим: установить в ячейке D1 - 0, изменяя значение в А1

AndVGri
Все получилось! Благодарствую!!!
Я понял насколько мало знаю об Exel.
Может посоветуешь какую-нибудь литературу по Office!

genf
Пройдитесь http://forum.ru-board.com/topic.cgi?forum=5&topic=19106 . Активнее используйте "книгу" Excel F1 , а если серьёзнее, то поищите на http://forum.ru-board.com/forum.cgi?forum=93. Закругляюсь, это уже флуд пошёл

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

Oleg24
Не забудьте установить reference on Microsoft VBScript Regular Expressions

Public Function GetNumberAfterText(ByVal CellText As String) As Double
Dim pReg As New RegExp
Dim pMatchs As MatchCollection
Dim pMatch As Match

pReg.Pattern = "-\d|\d"
Set pMatchs = pReg.Execute(CellText)
If pMatchs.Count <> 0& Then
Set pMatch = pMatchs.Item(0&)
GetNumberAfterText = CDbl(VBA.Mid$(CellText, pMatch.FirstIndex + 1&))
Else
Err.Raise 13&
End If
End Function

Дело в том что я вообще не знаю VBA. Текст во всех ячейках одинаков, а цифра разная. Все находится в одном столбце начиная с A1 и до 10000. Если можно дайте код не в процедуре или функции.

Oleg24
А Вы уверены, что задаёте вопрос в нужном разделе форума? Вам тогда сюда: http://forum.ru-board.com/topic.cgi?forum=5&topic=19106&start=1700#lt .
Если у Вас одинаковый текст перед числом, допустим "текст" - 5 символов, то формула будет:
=ЗНАЧЕН(ЗАМЕНИТЬ(A1;1;5;""))

Здрайствуйте. Помогите пожалуйста написать макрос который мог би заменять ошибки ДЕЛ/0 на листе формулу ЕСЛИ, чтоб вместо ошибки отображать 0. Не хочется вручну менять формулы.

Для одной ячейки. А мне для столбца нужно и средствами VBA.

hackman

Public Sub AddIf()
Const cFormulaCol As Long = 1&
Dim i As Long, vFormula As String
Dim vFirst As Long, vLast As Long

vFirst = ActiveSheet.UsedRange.Row
vLast = vFirst + ActiveSheet.UsedRange.Rows.Count - 1&

For i = vFirst To vLast
vFormula = Trim$(Cells(i, cFormulaCol).Formula)
If Mid$(vFormula, 1&, 1&) = "=" Then
vFormula = Mid$(vFormula, 2&)
vFormula = "=IF(ISERROR(" & vFormula & "),0," & vFormula & ")"
Cells(i, cFormulaCol).Formula = vFormula
End If
Next i
End Sub


Добавлено:
Oleg24 см.

Цитата:

"Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.

формула работает только в столбцеA

поетому
я написал так Public Sub AddIf()
Dim cFormulaCol As Integer
Dim i As Long, vFormula As String
Dim vFirst As Long, vLast As Long

For cFormulaCol = 1 To 256

vFirst = ActiveSheet.UsedRange.Row
vLast = vFirst + ActiveSheet.UsedRange.Rows.Count - 1&

For i = vFirst To vLast
vFormula = Trim$(Cells(i, cFormulaCol).Formula)
If Mid$(vFormula, 1&, 1&) = "=" Then
vFormula = Mid$(vFormula, 2&)
vFormula = "=IF(ISERROR(" & vFormula & "),0," & vFormula & ")"
Cells(i, cFormulaCol).Formula = vFormula
End If
Next i
Next cFormulaCol
End Sub

Есть закрытый файл с:\1.xls
Открыт 2.xls.
Как в макросе прописать копирование ячейки из 1.xls в 2.xls, не открывая 1.xls?

Итого: Как получить значения в VBA из закрытой рабочей книги?

filmax
Вопрос, конечно, интересный

Как вариант:
Cells(5, 1).Formula = "='D:\Documents\[1.xls]Лист1'!A5"
Debug.Print Cells(5, 1).Value


Добавлено:
hackman
Это был только пример. Диапазон столбцов можно получить из того же UsedRange
Начальный Activesheet.UsedRange.Column,
конечный Activesheet.UsedRange.Columns.Count + Activesheet.UsedRange.Column - 1&

filmax

strArg = "'" & strPath & "[" & strFileName & "]" & strSheetName & "'!" & _
Range(strCellRef)(1).Address(ReferenceStyle:=xlR1C1)
dYourValue= ExecuteExcel4Macro(strArg)

Здравствуйте. Помогите пожалуйста. нужен макрос. например:
С1=теущее значениеС1+А1-В1
и так для всех ячеек в калонках С, А и В
Кто занет как ето делать помогите чайнику, плз.

да по поводу как EXCEL создает папку ничего не получилось
ну да ладно вопрос решим по другому
а во вопросец по серьезнее
сам я сисадмин и програмер слабенький НО МНЕ ОЧЕНЬ ОЧЕНЬ НАДО вот это
Открываем новую книгу жму копку и пожалуйста
есть директория где лжат примерно 5000 папок (обращать внимание,что в этих папках есть еще папки ненадо). Таких директорий у меня с 10 и заставляют перебирать ручками
Просто маразм ПРОШУ СРОЧНО ПОМОЩИ СПЕЦИАЛИСТОВ ПО VBA
в каждой папке точно есть файл .xls
1 задача создать список папок в которых лежит только 1 файл EXCEL (там могут быть и другие файла)
2 создать список листов файлов EXEL
3 все папки с 1 файлом EXCEL вырезать из директории и поместить в папку1, которая лежит в исследуемой директории
4 создать список папок в которых есть по 2 файла EXCEL
5 вырезать эти папки из обследуемой директории и поместиь их в папку 2 в этой же директории
и 6 создать список папок где находятся более 2 файлов EXCEL

Добавлено:
ну и зачем меня модератору ругать
ведь никто не помог
та только отписка
да и задача несколько изменилась
я же все таки обращающь с специалистам а не к дедушке на деревню

да по поводу как EXCEL создает папку ничего не получилось
ну да ладно вопрос решим по другому
а во вопросец по серьезнее
сам я сисадмин и програмер слабенький НО МНЕ ОЧЕНЬ ОЧЕНЬ НАДО вот это
Открываем новую книгу жму копку и пожалуйста
есть директория где лжат примерно 5000 папок (обращать внимание,что в этих папках есть еще папки ненадо). Таких директорий у меня с 10 и заставляют перебирать ручками
Просто маразм ПРОШУ СРОЧНО ПОМОЩИ СПЕЦИАЛИСТОВ ПО VBA
в каждой папке точно есть файл .xls
1 задача создать список папок в которых лежит только 1 файл EXCEL (там могут быть и другие файла)
2 создать список листов файлов EXEL
3 все папки с 1 файлом EXCEL вырезать из директории и поместить в папку1, которая лежит в исследуемой директории
4 создать список папок в которых есть по 2 файла EXCEL
5 вырезать эти папки из обследуемой директории и поместиь их в папку 2 в этой же директории
и 6 создать список папок где находятся более 2 файлов EXCEL

evsino

Цитата:

да по поводу как EXCEL создает папку ничего не получилось

Что, конкретно, не получилось?


Цитата:

сам я сисадмин и програмер слабенький НО МНЕ ОЧЕНЬ ОЧЕНЬ НАДО вот это

Тогда Вам может быть сюда? http://forum.ru-board.com/topic.cgi?forum=33&topic=2395#1

так как см. "шапку" раздела -

Цитата:

Обратите внимание, этот топик для помощи в изучении и использовании VBA. Посему запросы типа "Напишите мне такой-то макрос, я VBA не знаю и знать не хочу" не приветствуются.
Древняя мудрость: "Накорми голодного рыбой и он погибнет, научи его ловить рыбу и ты спасешь его."(R)

Добавлено:
kiVAR

Cells(i, 3&).Formula = "=" & CStr(Cells(i, 3&).Value) & "+" & _
Cells(i, 1&).Address & "-" & Cells(i, 2&).Address

evsino
Цитата:

3 все папки с 1 файлом EXCEL вырезать из директории и поместить в папку1

а что значит "вырезать" ? Скопировать в папку с именем "ПАПКА1" ?
а то, что там могут быть ещё файлы (по вашим же словам) и подпапки? что с ними делать?

честно говоря, мне кажется что задача сама по себе безумная...
и вообще, я бы её делал не в VBA (а, например, на Дельфи ;-))))

SERGE_BLIZNUK
Ну, уж сразу и Дельфи

Подключаем Microsoft Scripting Runtime (как уже товарищу писали, чтоб проще методы вводить)
Set fso = New Scripting.FileSystemObject
'Получаем ссылку на корневую "супер 5000 подпапок" папку
Set pRootFolder = fso.GetFolder(sRootPath)
'Циклом по подпапкам
For Each pFolder In pRootFolder.SubFolders
'Проверяем, не является ли текущая подпапка одной из 3 назначения
...
'Если нет, то циклом по файлам, создав коллекцию для хранения xls файлов
Set pXlsCol = New Collection
For Each pFile In pFolder.Files
'Проверяем расширение и если xls, то добавляем в коллекцию
If LCase$(fso.GetExtention(pFile.Name)) = "xls" Then
pXlsCol.Add pFile
...
Next pFile
'Далее проверяем число файлов в коллекции и переносим в соответствующую папку
If pXlsCol.Count = 1& Then
fso.MoveFile pXlsCol.Item(1&).Path, pFolderFor1.Path & "\" & pFile.Name
...
Next pFolder
'Собственно после окончания сканирования подпапок, сканируем папку, куда складывали
'одиночные xls файлы, открываем их, составляем список листов и т. д.

Товарищ хоть бы попробовал (хоть объяснил где, куда, чего - ещё админ)

AndVGri

Спасибо за ответ, но вопрос был другой:
Цитата:

Как научить Shell понимать русские символы?

Как решить подобную задачу другими способами - я знаю. Но сама цель: может ли Shell "понять" русский? Это же вопрос я задаю Вам, товарищи профи.

Oyger

i = Shell("cmd /c del d:\temp\1\я_те*.txt /F /Q")

У меня удаляет без проблем. Файлы были "я_текст1.txt" и "Я_текст2.txt"

AndVGri

Я не знаком с cmd. Да и не могу на компе найти cmd.exe
У меня винда 98. Что посоветуешь? можно ее отдельно скачать и чтоб работала?
Или еще что хорошего предложишь?

Oyger

Х-м. У меня WinXP. Увы, command там то же есть, но он тоже удаляет без проблем. cmd в 98 не пойдёт.
Возможно, для решения задачи необходимо перекодировать название файлов в DOS кодировку, но у 98 command понимает только 8 символьные названия, а длинные надо форматировать в вид имфайл~1.txt, для примера.
Всё таки, если не секрет, чем не устраивает FileSystemObject?

AndVGri

Не секрет. Задачу, которую я привел - одна из нескольких. Есть и другие. Вот, к примеру, задача посложнее.
Есть папка. В ней около 30 файлов с данными. Надо их слить в один. Причем делать это надо каждый день. Это элементарно делается батником:
copy a.??? /A + b.??? /A c.??? /V
Или еще одна: есть файл большого размера - книга Екселя. Ее надо разрезать на кусочки приемлемого размера и разослать по Оутлуку. С рассылкой - все понятно. А режу я раром - заодно и размер уменьшается и проблем с соединением во едино частей нет. Рар - через бат. А бат - русский путь. Опять же.
Много, в общем, макросов завязано на функции батников. Можно броситься их переписать на язык ВБА, а можно в ВБА прописать батники, но для этого надо научиться их запускить из русскоязычных берикторий. Что и пытаюсь сделать.
А пока у меня на рабочем экране есть ярлыки антников. А работа выглядит следующим образом. Запускается макромс. Работает, работает. Потом выкидывает окно: "запустите такой-то бат". Ты его запускаешь. Он отрабатывает и ты жмешь "ок" в окне макроса. Тогда он заканчивет свое тело.

Да к тому же, я сторонник такой методики: если пользоваться только тем, что знаешь, то не будешь расти. Постоянно ищи новые пути решения.

Не утомил?
Так что если есть еще пердложения - как научить shell понимать русский под 98 виндой - буду рад услышать.

по поводу 5000 папок
есть директория например "ARCHIVE1" ее имя в макрос можно и ручками ввести
в этой дирректории я создаю папки "1,2" таких папок в этой дирректории точно нет
папки там типа "1123-23"
т.е. директории с одним знаком в имени не нужны для анализа
начинаем сканирование дирректории
открываем первую попавшую папку и видим там всего 1 файл EXEL
считываем имя папки имя папки заносим в список1 папку закрываем затем ее вырезаем и ложим ее в дирректорию 1 и опять берем следующую папку итд
мне надо отдельный список имен папок где 1 файл excel
отдельный список имен папок где 2 файла excel
+ где всего 1 или 2 файла excel лежали в дирректориях 1 и 2
папки где более 2 файлов excel пусть остаются в ARCHIVE1
далее надо получит список листов файлов excel издирректории1
дело в том что файлы excel в дирректории1 могут быть разными с разным кол-вом листом
и мне предстоит их дальнейшая сортировка
о ней уже молчу и вообще там еще задач с этим архивом огого
да и архив не один
Помогите конкретно
мне весь макрос нужен а не куски и рекомендации
ну пожалуйста бога ради а то хоть помирай

Oyger
Ну, не знаю. Запускать BATники из-под Excel VBA и не пользоваться его средствами, и ActiveX: Scripthing, RegMatch, Windows Scripting Host. Последний, кстати, позволяет нормально запускать программы, с Rar проблем не будет.

Цитата:

Постоянно ищи новые пути решения.

вот собственно и переходи на это. Головная боль, конечно, переделывать. Может хотя бы Win2k поставить?