» Excel VBA

slech

Цитата:

заходим на print, а там кнопочка 1 2 3 жмём на неё и печатается соответсвующий лист

Наверное, все-таки кнопочкИ 1, 2 и 3. Tak?
Да нет проблем.
Вызываешь Control toolbox, вставляешь кнопочки куда нужно на лист, меняешь Caption в свойствах кнопок. Затем двойным кликом по каждой кнопке попадаешь в ее код и вставляешь:
Код: Activeworkbook.Sheets("1").PrintOut

Troitsky
ок. Буду пробовать.

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

Возник вопрос: есть ли метод дающий коллекцию ячеек, содержащих определенное значение (как Find, только возвращающий не одну ячейку, а диапазон)? SpecialCells, к сожалению, возвращает только ячейки определенного формата и не может найти ячейки, содержащие, например, "тест" - может только найти все ячейки с текстовым значением .

MANRUS
Немного переработанный пример из хелпа:

Код: Sub ListFiles()
MyPath = "c:\temp\*.txt" ' Set the path.
i = 1
MyName = Dir(MyPath) ' Retrieve the first entry.

Do While MyName <> "" ' Start the loop.
MyName = Dir ' Get next entry.
Cells(i, 1).Value = MyName
i = i + 1
Loop
End Sub

Yuk
про пример из Хэлпа.... он игнорит первый файл в директории.

DeadVillage
Упс

Код: Sub ListFiles()
MyPath = "c:\temp\*.txt" ' Set the path.
i = 1
MyName = Dir(MyPath) ' Retrieve the first entry.

Do While MyName <> "" ' Start the loop.
Cells(i, 1).Value = MyName
i = i + 1
MyName = Dir ' Get next entry.
Loop
End Sub

народ, помогите, возможно я не в тему, тогда подскажите в какую мне тему.
есть таблица. используется постоянно в работе: на нее копирутся конфигурации компов и заказы клиентов.
так вот, таблица эта постоянно засирается какими-то левыми гиперссылками.
причем они как вирус плодятся сами.
бывает отлистаешь лист к самому верху, а там вообще нет ни одной ячейки без гиперссылки.
копирую все в буфер - вставляю значения на новый лист, делаю форматирование. такого рода очистки хватает на пару-тройку недель. потом имеем тоже самое в новой книге.
в самой книге никаких макросов вроде нет.
работа с книгой ведется с двух менеджерских компов.
ссылки двух видов:
mailto:aob@.videofon.net
http://www.attribute.ru/

Комп проверялся самыми разными антивирусами, переустанваливалась винда, офис. но все равно глюк сохраняется. возможно
Заметил, что вручную создать гиперссылку в пустой ячейке невозможно.
вопрос собственно в том - где порыть на предмет вредоносного кода.
постоянно пользуюсь прайсом этой конторы
http://www.attribute.ru/PRICE%20ATTRIBUTE.zip
помогите.. а то уже достало.

образец
http://plusik.nm.ru/hyperlinks.xls

Привет, всем!
Есть проблемма с оптимизацией кода на ВБА для екселя.
Есть макрос в екеселе, который импортирует данные из 3 текстовых файлов в таблицу, при этом делается поиск и некоторая простая обработка данных.
Все бы хорошо, но с производительностью напряг: первые 200-300 записей обрабатываются быстро, затем появаляются тормоза, причем чем дальше тем заметнее.
Опытным путем установил, что тормоза происходят при операции записи в ячейки ексельной таблицы.
Размер результирующей таблицы примерно 10000*20.
Посоветуйте, плз., как можно победить тормоза екселя!

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

ЗЗЫ: сначала скрипт просто разбирал файлы и загонял в таблицу данные, затем в целях победить тормоза в скрипте же сделал конвертацию текстовых файлов в DBFы, после чего запросом АДО, получаю необходиму таблицу с данными, считываю сразу весь recordset в массив с помощью GetRows и уже из массива заношу в таблицу. При этом все равно требуется небольшая обработка данных по условиям.

ИМХО: не должен ексел так тормозить, данных конечно много, но не столько же чтоб уложить его на повал. Комп у меня нормальный Пень4 3200, 512 Мб. все данные лежат на локальном диске, в т.ч. и промежуточные DBFки.

Добавлено:
вопрос снят - надо было просто выключить расчет формул.
Извиняюсь за беспокойство

The okk

Цитата:

Возник вопрос: есть ли метод дающий коллекцию ячеек, содержащих определенное значение (как Find, только возвращающий не одну ячейку, а диапазон)? SpecialCells, к сожалению, возвращает только ячейки определенного формата и не может найти ячейки, содержащие, например, "тест" - может только найти все ячейки с текстовым значением

Вот здесь.

Добавлено:
P.S. Когда сделаешь ListView?

Plusik
чего-то все молчат как рыбы...
А я хотел послушать, что скажут умные и опытные гуру... Ладно. Раз молчат, прийдётся мне сказать немного.
1) у меня стоит настройка безопасности "Безопасность макросов" - средняя - спрашивать у пользователя.
Так вот, при открытии вашего hyperlinks.xls происходит запрос на отключение макросов.
Внутри в Class Modules какой-то Class1 После export'а [more]VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
[/more] что это, откуда взялось и зачем нужно я не понимаю...

2) появление строчек с "mailto / http" могу объяснить тем, что кто-то из менеджеров использует при копировании информацию с какой-то книги с гиперссылками или с Web online (кстати наиболее вероятный вариант)...

3) для решения проблемы нужно поймать его за этим делом... и отвыкнуть...
Но, в качестве альтернативного варианта, раз уж мы в ветке программирования - можно написать макрос, который удаляет ВСЕ гиперссылки. И засунуть его на Open или на BeforeSave...

Anton T
Спасибо. Это я для твоего случая метод пишу (чтобы ListView заполнялся согласно фильтру). На другом форуме посовещались. Решается через SpecialCells и AdvancedFilter:

Код: Sub Macro1()
Dim strMsk As String, rng As Range, rngCrit As Range

On Error Resume Next
strMask = InputBox("Insert a mask", "Select by mask", "'=TEST*")
Set rngCrit = Sheets("Sheet2").Range("A1:A2")
Set rng = Sheets("Sheet1").[C:C]
rngCrit(1) = rng(1)
rngCrit(2) = strMask

rng.AdvancedFilter xlFilterInPlace, rngCrit
rng.Resize(rng.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants).SpecialCells(xlCellTypeVisible).Select
rng.Parent.ShowAllData
End Sub

The okk
Пробовал, не получается.
А может DataGrid(табличный набор)?

Anton T
да тут дело не в том, что записывать, а именно как и куда записывать. Т.е. не так важно, что будет в правой части, лишь бы по типу и размерности подходило. - Там должен быть просто массив строк (String). Можно просто через запятую: Array (str1,str2,str3...,strN).
Важно, в какой форме должна быть левая часть.

Есть лист ЗП со следущими данными:
Иванов    1 отдел    2500
Петров    1 отдел    3500
Сидоров    2 отдел    2000
Петров    2 отдел    2500
Иванов    3 отдел    2200
где столбцу А присвоила имя Фамилия, столбцу В - Отдел
Есть лист КолЧас со следующими данными:
Иванов    3 отдел    14
Петров    2 отдел    18
Сидоров    2 отдел    20
Петров    1 отдел    10
Иванов    1 отдел    9
где столбцу А присвоила имя Фамилия1, столбцу В - Отдел1

Есть лист Общая, куда копируются данные с листа ЗП и копируется с листа КолЧас только 3 столбец с количеством часов, но так, чтобы эти часы скопирвались в те ячейки, в которых соотвествствовала фамилия и отдел. Используя запись макроса, получила следующий код:
Sub Макрос2()
'
' Макрос2 Макрос
' Макрос записан 22.01.2007 (DIREKTOR)
'

'
Sheets("ЗП").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(Фамилия,Отдел)"
Range("A1").Select
Selection.Copy
Range("A2:A5").Select
ActiveSheet.Paste
Sheets("КолЧас").Select
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(Фамилия1,Отдел1)"
Range("A1").Select
Selection.Copy
Range("A2:A5").Select
ActiveSheet.Paste
Sheets("ЗП").Select
Columns("A:D").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Общая").Select
Columns("A:D").Select
ActiveSheet.Paste
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],КолЧас!C[-4]:C[-1],4,FALSE)"
Range("E1").Select
Selection.Copy
Range("E2:E5").Select
ActiveSheet.Paste
End Sub
Теперь пытаюсь оптимизировать этот код, исключив вставку нового столбца на всех листах, но ничего не получается. Вот что я написала, используя предыдущие подсказки:
Sub Копирование()

Dim i As Variant
Dim j As Variant
Dim i1 As Variant
Dim j1 As Variant
Dim p As Variant
Dim p1 As Variant

Range("A1", Range("A65536").End(xlUp)).Copy Sheets(3).Range("a1")
Range("b1", Range("b65536").End(xlUp)).Copy Sheets(3).Range("b1")
Range("c1", Range("c65536").End(xlUp)).Copy Sheets(3).Range("c1")

With Sheets("ЗП")
i = Range("A1", Range("A65536").End(xlUp))
j = Range("B1", Range("B65536").End(xlUp))

p = "=i&"" ""&j"

End With

With Sheets("КолЧас")
i1 = Sheets("КолЧас").Range("A1", Range("A65536").End(xlUp))
j1 = Sheets("КолЧас").Range("B1", Range("b65536").End(xlUp))

p1 = "=i1&"" ""&j1"
End With

If p = p1 Then

Sheets("КолЧас").Activate
Range("c1", Range("c65536").End(xlUp)).Copy Sheets(3).Range("d1")

End If


End Sub
Может кто поможет?

SERGE_BLIZNUK
сенькс за участие.

Pantera3587
А зачем тут макрос? Это решается формулами (посмотри в хелпе описание функции ВПР).

Pantera3587
Лист ЗП куда скорпировать? В листе КолЧас до конца строки?

Добавлено:
Pantera3587
Sub копия()
Dim NextRow As Long
Dim a As Integer

NextRow = Application.WorksheetFunction.CountA(Worksheets(2).Range("A:A")) + 1
Worksheets(1).Activate
Range("a1", Range("A65536").End(xlUp)).Copy Sheets(2).Cells(NextRow, 1)

End Sub

Anton T
Нет, лист ЗП копируется в лист Общая, лист КолЧас тоже на лист Общая, только со второго листа копируется в лист Общая последний столбец, т.е. он добавляется к уже скопированным данным с листа ЗП. Если посмотреть на данные, то, например, Иванов 1 отдел на листе ЗП находится в первой строчке, а на листе КолЧас в последней, а на листе Общая должна сформироваться таблица, где оставшиеся данные должны скопирваться именно для Иванова 1 отдел (цифра 9 при копировании с листа КолЧас должна оказаться на листе Общая в четвертом столбце в строке 1) и т.д.

The okk
Действительно с помощью функции эта задача решается очень просто, но приходится каждый раз добалять лишний столбец на все листы, использовать функцию сцепить, т.к. данные, например, фамилии повторяются, а функция ВПР ищет только первое совпадающее значение, но по второму столбцу данные то разные. Поэтому хочется написатьтакой макрос, который бы исключал добавление лишнего столбца.

Может не очень понятно написала?

Pantera3587
Т.е. нужно находить значение по первым двум столбцам (фамилия и отдел)?

The okk
Да.

Pantera3587
А почему нельзя просто сортировку включить (по двум первым столбцам) и подставить прямые ссылки?
Сортировка как раз даст прямое соответствие.

Pantera3587
Немного не по теме, но все же.
А Вы исключаете наличие в одном отделе двух человек с одинаковой фамилией?

The okk

Я уже думала об этом, но дело в том , что таблицы на листах могут отличаться, т.е. в одной таблице на листе ЗП данных по строкам может быть больше, чем на листе КолЧас. Когда количество данных по строка совпадает, единственное что они могут быть разбросаны в хаотичном порядке, то проблем нет. Я уже это попробовала без макроса. В акцесе эта задача тоже очень легко решаема. А вот в экселе не могу придумать как выполнить эту задачу. В принципе нашала здесь один код:

Sub СЦЕПИТЬ()
Dim Rowcounter As Long
With Selection
For Rowcounter = 1 To .End(xlDown).Row
If Len(.Cells(Rowcounter, 1)) = 0 Then
Exit For
End If
.Cells(Rowcounter, 1) = .Cells(Rowcounter, 1) & "-" & _
.Cells(Rowcounter, 2)
Range(Cells(Rowcounter, 1), Cells(Rowcounter, 2)).Merge
Next
End With
End Sub
Т.е. мы как-бы из двух столбцов делаем один на одном листе и тоже самое на другом листе, но этот код во-первых, объединяет два столбца, нажав при этом мгного раз на кнопку ОК в открывающемся окне, т.е. если таблица содержит 100 строк, то инажать надо кнопку ОК 100 раз, во-вторых, после этого кода происходит объединение двух ячеек и сортировка в таком случае не работает. Надо снимать объединение. Хотя этот код можно было бы как-то применить, если бы он в первом столбце создавал текст из значений двух ячеек, но при этом не объединял бы их. Тогда можно применить сортировку, т.к. соединенные значения уже не будут совпадать.

Добавлено:
Yuk
Вообще то не исключено, что в одном отделе может находится, например несколько Сидоровых. Наверное, тогда надо включать еще какой-нибудь столбец с данными, которые бы были отличны у одинаковых фамилий.

Добавлено:
The okk
Кстати, этот код нашла у тебя на странице 55

Pantera3587
Цитата:

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

Уважаемая, а не проще будет добавить табельный номер, который по определению не может быть одинаков у разных людей (хоть в одном отделе, хоть в разных)! И тогда ВПР решит вашу задачу...

SERGE_BLIZNUK
Можно, но бывают таблицы с другими данными, где не может присутствовать табельный номер, например, такая на одном листе:

Фамилия    КодА    КодАВ    СО    Значение
иванов    Р142    Р1412    цо    350
петров    Р142    Р1412    цо    0
сидоров    Р142    Р1412    цо    0
хомяков    Р142    Р1412    цо    0

а на другом такая:

Фамилия    КодА    КодАВ    СО    Значение1
иванов    Р142    Р1412    цо    58
петров    Р142    Р1412    цо    2
сидоров    Р142    Р1412    цо    317
хомяков    Р142    Р1412    цо    309
иванов    Р142    Р1413    цо    450

Pantera3587
не совсем понял, как у нас фамилия и отдел трансформировались в КодА КодАБ и т.д....

поэтому кину решение (ну, на мой взгляд, методику или алгоритм решения) первоначальной задачи:

Как я понимаю, вам нужен только один дополнительный столбец -
на листе КолЧас в стобце A должна быть формула
=СЦЕПИТЬ(Фамилия1;Отдел1)

Тогда в любом (!!) месте, где вам нужно получить значение
Кол-ва часов
(например, в то же листе ЗП вставляете формулу вида:
=ВПР(СЦЕПИТЬ(Фамилия;Отдел);КолЧас!$A:$D;4;ЛОЖЬ)
(разумеется, строчка вставки формулы должна соотвествовать фамилии/отделу)

если это делать на новом листе (типа "Общий", то тогда туда надо
перенести данные с листа ЗП (Фамилия, Отдел))
- это (перенос) можно сделать как макросом, так и (предпочтительнее),
просто вставив формулы вида =Фамилия =Отдел
(ну, или ссылки на ячейки листа =ЗП!$A1)

Pantera3587
Кстати, я когда-то писал функцию для поиска по нескольким полям. Два варианта вот здесь:
http://forum.ru-board.com/topic.cgi?forum=5&topic=19106&start=380#7
http://forum.ru-board.com/topic.cgi?forum=5&topic=19106&start=380#17
Посмотри там обсуждение, может пригодится.

SERGE_BLIZNUK
То, что ты предлагаешь, не будет работать. Просто ты не можешь понять суть задачи. Просто сделай на одном листе (ЗП) таблицу:
Петров    3 отдел    1500
Сидоров    2 отдел    2000
Иванов    3 отдел    2200
Иванов    1 отдел    2500
Петров    2 отдел    2500
Петров    1 отдел    3500

на другом листе (КолЧас) такую:
Иванов    1 отдел    13
Петров    1 отдел    10
Петров    2 отдел    18
Сидоров    2 отдел    20
Иванов    3 отдел    9
затем скопируй таблицу с первого листа на третий лист (Общая), а с листа КолЧас скопируй только третий столбец и вставь в лист Общая в четвертый столбец. Только скопирвать нужно так, чтобы, например, цифра 9 скопировалась на третью строчку, цифра 18 - на пятую.

Добавлено:
Yuk
Объясни, что нужно вводить в поле LookUp (смотреть?), что в From (вроде в переводе из) и что в Fist хотя бы на моем примере выше.

Pantera3587
Цитата:

То, что ты предлагаешь, не будет работать. Просто ты не можешь понять суть задачи

Да понимаю я, что вы хотите.
Давайте спокойно. Просто ответьте на очень простые вопросы:
1) Возможно ли вставить на лист (КолЧас) дополнительный столбец A ?
(там будет формула сцепления для поиска кол-ва часов)
2) Обязательно ли требование, чтобы на листе (Общая) были не формулы/ссылки,
а именно значения?
3) Вам присать файлик XLS, который работает - т.е. на листе "Общая" данные - все четыре столбца обновляются сразу после добавления/измения/удаления данных в листах "ЗП" и "КолЧас" ?

и последний вопрос - я ещё сам не глянул, то, что предложил Yuk, но, Вы уже посмотрели? Я догадываюсь, что он плохого не предложит ;-))
Может быть, задача уже решена?