» Excel VBA (часть 2)

Здравствуйте.
Помогите ме с таким заданием плз.

Необходимо написать пользовательскуб функцию в Excel, которой в качестве аргументов передаются диапазоны ячеек с исходными данными. Нужно сложить два массива размера N x N. Функция должна вернусть массив.
Примечание: функция не должна использовать встроеных функций Excel для обработки результатов.

skawl
у Вас самого-то есть хоть наброски как сделать? или Вам полностью готовое на блюдечке надо?
давайте свои варианты, а мы подправим.

To ALL

У меня вопрос:
есть код, который вставляет на лист картинки:
Код:
For j 1 To 10
Range("A" & j).Select
ActiveSheet.Pictures.Insert("D:\1.JPG").Select
Next j

Function tut(a, b)
Dim AB() As Variant
Dim i As Integer, j As Integer
n = a.Rows.Count
m = a.Columns.Count
Dim elem As Variant
For i = 1 To n
For j = 1 To m
elem = 0
elem = a(i, j) + b(i, j)
AB(i, j) = elem
Next j
Next i
tut = AB
End Function


Сейчас вот такое. Только всеравно ЗНАЧ выбивает

Как запустить книгу в режиме "свернуть"?
То есть вообще не отображать окно excel

что-то вроде этого:
Private Sub Workbook_Open()
скрыть книгу
End Sub

CEMEH

может я чего НЕ понял ... но ...

Application.ActiveWindow.Visible = False

Обнаружил реальную несовместимость Excel 2003 и 2007 !!!
На листе создаем кнопку, в неё пишем код:

Код: Private Sub CommandButton1_Click()
Range("G13").Select
ActiveSheet.Pictures.Insert("D:\1.gif").Select
End Sub

TONADOOM
ну а ПЕРЕМЕСТИТЬ картинку?

Selection.ShapeRange.IncrementLeft 300
Selection.ShapeRange.IncrementTop 200

Подскажите как можно реализовать ..

исходное
---------------------
type1 sometext1 sometext3
type1 sometext2 sometext5
type1 sometext4 sometext7
type2 sometext6 sometext9
type2 sometext8 sometext11
type2 sometext10 sometext13
type3 sometext12 sometext15
type3 sometext14 sometext17
-----------------------
результат
type1
+ sometext1 sometext3
sometext2 sometext5
type2
+ sometext6 sometext9
sometext8 sometext11
sometext10 sometext13
type3
+sometext12 sometext15
sometext14 sometext17

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

grepper, это можно реализовать достаточно несложным макросом.
Только при одном условии - у вас строчки упорядочены (ну, хотя бы по первому слову)
(как, впрочем, это и нарисовано у Вас в примере).
Алгоритм примерно такой.
currType = "#$#"
цикл от первой записи до последней
выделяем слово из строки (тип)
если выделенный тип <> currType
currType = выделенный тип
записываем тип currType
конец если
записываем оставшуюся часть исходной строки с отступом
конец цикла

p.s. а вообще, если хотите реальной помощи в виде готового макроса - то нарисуйте маленькую Excel табличку с исходными данными. Там же обязательно нарисуйте как должно получится. полученный xls запаковать, кинуть на любой файлобменник, сюда ссылочку на скачивание...

выполняется макрос, который вызывает внешную программу, та в свою очередь выполняет свои действия, результатом которых является новая книга экселя...
и вот возникает проблема - как определить имя новой книги?
код типа:

Код:
for each wb in workbooks
debug.print wb.name
next

Есть в книге выдленная ячейка... как расширить выделение еще и на соседнюю?

grepper
на вскидку, например, я не скажу.
на "соседнюю" что? группу? Если у Вас выделено две группы ячеек квадрат 3x3 и квадрат 5X5 ??

???

Хотя, конечно, мне кажется, что в общем случае это можно сделать, но сложно (через объединение интервалов уже выделенного диапазона с ячейкой(ячейками) левее - это ещё разобраться, что Вам надо!)

но проблема в том, что я уверен - это Вам НЕ НУЖНО!!!!
для обработки данных в VBA не надо их выделять (это только вредит!!!!!!!)
обрабатывайте ячейки через Cells (или Range)!

подскажите хоть как получить название всех приложений которые есть в панели задач...
как это можно сделать с помощью WinApi и может есть методы попроще?

grepper
ну МОЖНО так попробовать ...

Sub Макрос1()

Set r = Range("B5")

a = 3
b = 6

c = r.Row
d = r.Column

Range(Cells(c, d), Cells(c + a, d + b)).Select

End Sub

ПРивет!
Есть задачка: существует книга ексель с листами, каждый из которых разделен на 2 области. В одной области вводится значение (например, в одну ячейку - ФИО, во вторую - Отдел и т.д.), во второй области эти значения стандартизируются (приводятся к верхнему регистру, усекаются и т.д.).
Существует кнопка, при нажатии на которую (после заполнения листов информацией) все листы книги разносятся по определенным директориям и сохраняются там в виде отдельных ексель файлов с одним конкретным листом.
Вопрос: необходим макрос, который будет помимо формирования ексель файлов делать ЦСВ файл с разделителями, но сохранять в него ТОЛЬКО данные из второй области каждого листа.

ВБА вижу 2-й раз в жизни 8)
Вот что смог сделать:

With Worksheets(sTab).Range("a1:ea2") ' определяем начало второй области
Set c = .Find("start cell", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address()
End If
End With

With Worksheets(sTab).Range("a5:ea200") ' ищем окончание области для выделения
Set cc = .Find("end cell", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cc Is Nothing Then
lastAddress = cc.Address()
Do
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> lastAddress
End If
End With

Range(firstAddress, lastAddress).Select
Sheets(sTab).Select
Sheets(sTab).Copy


ActiveWorkbook.SaveAs Filename:= _
sPath & "\" & sTab & " v1.0.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close (True)

Этот пример сохраняет отдельный лист в отдельный файл, но оставляет все содержимое листа и просто выделяет вторую область, вместо того, что бы сформировать лист и вставить в него диапазон Range(firstAddress, lastAddress).

Как это сделать средствами ВБА?? Знаю, что здесь не хватает самую малость, но не могу найти (или не правильно применяю) эти функции 8(

ЗЫ: Если прописывать
Range(firstAddress, lastAddress).Select
Range(firstAddress, lastAddress).Copy
то книга просто копируется в первую директорию.
Чего тут не хватает (ну не знаю я ВБА, изучить - времени нет 8()?

cio_new
ну так СОЗДАЙТЕ новую книгу (МАКРОРЕКОРДЕР Вам в руки) ...
и после ...
Range(firstAddress, lastAddress).Select
пишем ...
Selection.Copy
отправляемся на новый лист ...
Windows("Книга1").Activate
Range("C5").Select ' Например
ActiveSheet.Paste

хотя может я ЧЕГО пропустил ...

jocer

Вам тоже это Windows("Книга1").Activate подойдет наверное ...
так как Ваш файл, ИЗ которого Вы запускаете КОД уже имеет название, а следующий файл будет АВТОМАТИЧЕСКИ назван Книга1 ...

что в этом роде ...

WowGun
Спасибо за ответ!
Чес слово не знаю, как ее создавать (книгу), и тем более как отправиться на новый лист.
Вот что подумал после Вашего ответа (не работает):

Dim oWbk As Workbook
Dim oWorksheet As Worksheet
Application.DisplayAlerts = False
Set oWbk = Application.Workbooks.Add()
For Each oWorksheet In oWbk.Worksheets
If oWorksheet.Name = "&#203;&#232;&#241;&#242;1" Then
oWorksheet.Name = sTab
ElseIf oWorksheet.Name = "&#203;&#232;&#241;&#242;2" Then
oWorksheet.Name = "csv"
Else
oWorksheet.Delete
End If
Next


With Worksheets(sTab).Range("a1:ea2")
Set c = .Find("Import File Generation. PLEASE DO NOT EDIT.", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address()
End If
End With

With Worksheets(sTab).Range("a5:ea200")
Set cc = .Find("n", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
If Not cc Is Nothing Then
lastAddress = cc.Address()
Do
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> lastAddress
End If
End With
Range(firstAddress, lastAddress).Select
Selection.Copy

oWbk.Activate
oWorksheet(1).Activate
Range("C5").Select
ActiveSheet.Paste

ActiveWorkbook.SaveAs Filename:= _
sPath & "\" & sTab & " v1.0.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close (True)

cio_new
и так ...
Set oWbk = Application.Workbooks.Add()
For Each oWorksheet In oWbk.Worksheets
If oWorksheet.Name = "&#203;&#232;&#241;&#242;1" Then
oWorksheet.Name = sTab
ElseIf oWorksheet.Name = "&#203;&#232;&#241;&#242;2" Then
oWorksheet.Name = "csv"
Else
oWorksheet.Delete
End If
Next
создали НОВУЮ книгу ...
Set oWbk = Application.Workbooks.Add()

и теперь в НОВОЙ книге Вы почему-то ИЩИТЕ старые названия листов?
For Each oWorksheet In oWbk.Worksheets
ТАМ Вы их НЕ найдете ...

сюда положил небольшой эксель с примером того, что надо сделать...
может конечно для этого есть стандартная функция какая то, но я про неё не знаю
http://www.rapidshare.ru/983689

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

WowGun
>и теперь в НОВОЙ книге Вы почему-то ИЩИТЕ старые названия листов?
>For Each oWorksheet In oWbk.Worksheets
Нет, в новой книге я меняю названия листов по умолчанию на нужные мне названия при помощи For Each oWorksheet In oWbk.Worksheets
Скажите плз, каким образом я могу скопировать диапазон из старой книги и поместить в новую?

Добрый день Знатоки!
Кто подскажет макрос?
Есть таблица, то есть Счет-фактура
После заполнения первой строки, при нажатии Enter автоматом добавляется вторая строка И тд
Спасибо!

ToALL
Скажите, как заствить макрос выполнятся только на активном листе книги (если есть несколько листов) ?
Буду благодарен любой помощи.

Друзья, подскажите плиз.

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

mistx

Код:
Dim i As Integer
For i = 1 To 50
Select Case Cells(i, 1) 'Тут единица, это номер столбца
Case Is = 1 'Первое условие для первого столбца
Cells(i, 2) = 2 'Значение второго столбца, при выполнение условия
Case Is > 5 'Второе условие
Cells(i, 2) = 10 'Значение второго столбца, при выполнение условия
End Select
Next i

Fierce1

Цитата:

Условий можешь писать сколько угодно

Я наверное не точно объяснил

имеется диапазон организаций
G5944-G6043 (1 столбец)
и диапазон H5944-H6043 (типы организаций) - 2 столбец

на этом же листе есть таблица2 со столбцами "организ-я" и "тип" (данные импортируются из txt)

нужно, чтобы в столбце ТИП, макрос считывая данные столбца Организация таблицы2 (которые импортировались) указывал тип организации основываясь на списке диапазона G5944-G6043, которую я вбил как шаблон.

mistx
Пробуй


Код:
Dim i As Integer
Dim j As Integer
For j = 1 To 50
For i = 1 To 50
If Cells(1 + j, 1) = Cells(20 + i, 6) Then
Cells(1 + j, 2) = Cells(20 + i, 7)
End If
Next i
Next j

Fierce1
вот это - тема.
а если есть орган-и со 2 по 35489 строку.
а на другом листе с первой строки и первого столбца идет шаблон.

можно реализовать?

mistx
Можно, поменяй просто в коде j=1 to 35489 (это сколько строк тебе надо заполнить), i - это сколько строк у тебя шаблон. Cells (номер строки, номер столбца) указывает проверяемую ячейку. Чтобы сослаться на другой лист, Worksheets("название листа").cells(номер строки, номер столбца). И еще, перед end if нужно добавть exit for, чтобы при нахождении нужной ячейки, он не перебирал дальше, а переходил на следующую ячейку. Это будет выглядеть примерно так:

Код:
Dim i As Integer
Dim j As Integer
For j = 1 To 35488
For i = 1 To 50 'Тут сколько строк у тебя шаблон
If Cells(1 + j, 1) = Worksheets("название листа").Cells(i, 1) Then
Cells(1 + j, 2) = Worksheets("название листа").Cells(i, 2)
Exit For
End If
Next i
Next j

mistx
Fierce1
ребят, может я чего не догоняю, конечно, но чем в данном случае ВПР не устраивает?!

добавлено.
понял - в шаблоне сравнивается не одна ячейка, а много... :-)

cio_new

For Each oWorksheet In oWbk.Worksheets
If oWorksheet.Name = "&#203;&#232;&#241;&#242;1" Then
oWorksheet.Name = sTab
ElseIf oWorksheet.Name = "&#203;&#232;&#241;&#242;2" Then
oWorksheet.Name = "csv"
Else
oWorksheet.Delete
End If
Next

Итак, 1-я строка - обращение ко всем листам НОВОЙ книги.
2-я строка - ПРОВЕРЯЕТ ... ЕСТЬ ли в НОВОЙ книге лист с ИМЕНЕМ &#203;&#232;&#241;&#242;1 ... а ОТКУДА ... в НОВОЙ книге лист с ТАКИМ именем? в НОВОЙ книге листы именуются СТАНДАРТНО ... Лист1, Лист2 ... и т.д. ...
3-я строка - ЕСЛИ Вы НАЙДЕТЕ в НОВОЙ книге ЭТОТ лист (а его там НЕТ!!!) то Вы этому листу присвоите ДРУГОЕ имя ....
4 и 5-я - то же самое ...
7-я ... ЕСЛИ Вы листы с ТАКИМИ именами НЕ найдете ( а их там НЕТУ!!!) то Вы удалите ВСЕ листы ...

вряд ли Вы именно ТАК и задумывали ...