» Excel VBA (часть 2)

Код:
Workbooks.Open Filename:="C:\2Lab\VBA\База Кадров.xls"

Range("E1").Select
ActiveCell.FormulaR1C1 = "Дата рождения"
Range("E1").Select
Columns("E:E").ColumnWidth = 14.29
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Range("F1").Select

ActiveCell.FormulaR1C1 = "Именинники"
Columns("E:E").Select
Selection.NumberFormat = "m/d/yyyy"
' Возвращает текущие день и месяц
strDay = Day(Now()) & "." & Month(Now())
Columns("F:F").Select
Selection.NumberFormat = "@"
' Сравнивает значение в ячейке E2 по дню и месяцу рождения человека с текущим strDay
If Day(Range("E2").Value) & "." & Month(Range("E2").Value) = strDay Then
Range("F2").Value = "Именинник"
Else

End If

pila007
И в какой части кода проблема, приведи?

XPurple

Цитата:

Как применить это правило к столбцу E:E

Код:
strDay = CStr(Day(Now) * 100 + Month(Now))
Range("F:F").FormulaR1C1 = "=IF((DAY(R[0]C[-1])*100+MONTH(R[0]C[-1]))=" & _
strDay & ",""Именинник"","""")"

2.Ввести массив A(N,M).Найти сумму элементов двух главных диагоналей.
а правильно я решил?
Sub two()
Dim a(5, 2) As Double
Cells(6, 1) = 0
For i = 1 To 5
For j = 1 To 2
Cells(i, j) = Int(Rnd * 6)
a(i, j) = Cells(i, j)
Cells(6, 1) = Cells(6, 1) + a(i, j)
Next j
Next i
End Sub

pila007

Цитата:

Dim a(5, 2) As Double

А что понимается под главной диагональю при такой размерности массива?

нет я задачей ошибся, не тут отправил
Sub two()
Dim a(3, 3) As Double
Cells(4, 1) = 0
Cells(5, 1) = 0
For i = 1 To 3
For j = 1 To 3
Cells(i, j) = Int(Rnd * 3)
a(i, j) = Cells(i, j)
Cells(4, 1) = a(1, 1) + a(2, 2) + a(3, 3)
Cells(5, 1) = a(1, 3) + a(2, 2) + a(3, 1)
Next j
Next i
End Sub

Цитата:

Sub two()
Dim a(3, 3) As Double
Cells(4, 1) = 0
Cells(5, 1) = 0
For i = 1 To 3
For j = 1 To 3
Cells(i, j) = Int(Rnd * 3)
a(i, j) = Cells(i, j)
Cells(4, 1) = a(1, 1) + a(2, 2) + a(3, 3)
Cells(5, 1) = a(1, 3) + a(2, 2) + a(3, 1)
Next j
Next i
End Sub

Код: Sub two()
Dim a(3, 3) As Double
Cells(4, 1) = 0
Cells(5, 1) = 0
For i = 1 To 3
For j = 1 To 3
Cells(i, j) = Int(Rnd * 3)
a(i, j) = Cells(i, j)
Next j
Next i
Cells(4, 1) = a(1, 1) + a(2, 2) + a(3, 3)
Cells(5, 1) = a(1, 3) + a(2, 2) + a(3, 1)
End Sub

В VBA я новичек. Не могу написать макрос в Excel, уже на стены лезу.

Дано:

носки 45
трусы 43
штаны 75
майки 28
шубы 67
чай 56
кофе 54
сало 32

Нужно чтобы они делились по суммам в 150 штук, то есть вот так:

носки 45
трусы 43
штаны 62

штаны 13
майки 28
шубы 67
чай 52

чай 4
кофе 54
сало 32

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

prosims
Не лезь, допирай
[more]

Код:
Public Sub SplitListBy150()
Dim i As Long, pos As Long, vId As Long, vSum As Long
Dim pSource As Worksheet, pDest As Worksheet

Set pSource = ActiveSheet
Set pDest = Worksheets.Add
vId = 1&: vSum = 0&: pos = 1&

For i = 1& To 8&
If (vSum + pSource.Cells(i, 2&).Value) > 150& Then
pDest.Cells(pos, 1&).Value = pSource.Cells(i, 1&).Value
pDest.Cells(pos, 2&).Value = 150& - vSum
pDest.Cells(pos, 3&).Value = vId
vSum = pSource.Cells(i, 2&).Value - 150& + vSum

vId = vId + 1&: pos = pos + 2&
pDest.Cells(pos, 2&).Value = vSum
Else
pDest.Cells(pos, 2&).Value = pSource.Cells(i, 2&).Value
vSum = vSum + pSource.Cells(i, 2&).Value
End If
pDest.Cells(pos, 1&).Value = pSource.Cells(i, 1&).Value
pDest.Cells(pos, 3&).Value = vId
pos = pos + 1&
Next i
End Sub

Такой вопрос - нужно отсортировать массив по алфавиту. Есть ли какие-ниить встроенные ф-ции? Или если нет, хотя бы пример дайте посмотреть, плз. А то чет читаю мануал никак не найду, где там сортировка массивов

PhpRu
Встроенных нет. Слей массив на рабочий лист, отсортируй, используя, Range.Sort и загрузи обратно. Или, как альтернативу, используй любой из алгоритмов сортировки массивов, используя StrComp

PhpRu
Например,
Сортировка массива данных по порядку
Сортировка методом Шелла
и т.д.

А про рабочий лист поподробнее можно? Мне ваще даже не в массиве сортировать а в выпадающем списке. Может там есть свойство у этого компонента?

PhpRu
Свойства Sorted я у ComboBox не нашел, но ведь можно просто отсортировать источник списка (ControlSource ведь у него есть).

AndVGri
Спасибо

помогите плиз....

1.Есть кнопка на листе .нужно .чтобы при нажатии на неё открылось диалоговое окно "открытия документа",дальше ,чтобы я выбрал нужный мне файл и открыл его.Файлы показывать только Эксел. Я дошёл только до открытия окна дальше ничего не могу сделать.

2. Есть макрос такого вида
If Range("K5").Value <> 0 Then
Rows("5:5").EntireRow.Hidden = False

и таких строчек ещё 23 штук
вообщем последняя
If Range("K28").Value <> 0 Then
Rows("28:28").EntireRow.Hidden = False
как это записать всё короче ,наверное нужно использовать цикл?
3. как запретить пользователю добавлять панели инструментов

ответьте плиз ....очень нужно

GFSGF
1. Покажи код. Что не получается?
2. Range("K5:K28").SpecialCells(xlCellTypeBlanks).Entirerow.Hidden = False

Filename=Application.GetOpenFilename()
If Filename<>False Then
Debug.Print Filename
End If
Вот это всё что я нашёл в книге по VBA


Добавлено:
The okk
Range("K5:K28").SpecialCells(xlCellTypeBlanks).Entirerow.Hidden = False
этот код какое условие проверяет? Почему то выходит ошибка .что ничего не найдено для удовлетворения этого условия.

не как не могу решить доконца эту задачку, подскажите что я сделал неправильно
Задание такое:
3.Заполнить массив A(N) нечетными членами натурального ряда (1,3,5….) до тех пор пока их сумма не станет больше произвольного числа М. Найти произведение членов ряда и их число.
Sub three()
Cells(1, 4) = 0
Cells(1, 5) = 1
s = 0
k = 1
i = 0
p = 1
ReDim a(20): m = Cells(1, 2)
For i = 1 To 20
Do While s <= m
a(i) = k
i = i + 1
p = p * k
s = s + k
k = k + 2
Loop
Next i
Cells(1, 4) = i
Cells(1, 5) = p
End Sub

GFSGF

Цитата:

Filename=Application.GetOpenFilename()
If Filename<>False Then
Debug.Print Filename
End If

На самом деле, у GetOpenFileName имеются параметры


Код: FileName = Application.GetOpenFilename _
(FileFilter:="Файлы MS Excel (*.xls), *xls", _
FilterIndex:=1)

If FileName = False Then Exit Sub

WorkBooks.Open(FileName)

GFSGF

Цитата:

Вот это всё что я нашёл в книге по VBA

F1 выломана? Тогда держи
[more]
GetOpenFilename Method

Displays the standard Open dialog box and gets a file name from the user without actually opening any files.

expression.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
expression Required. An expression that returns an Application object.

FileFilter Optional Variant. A string specifying file filtering criteria.

This string consists of pairs of file filter strings followed by the MS-DOS wildcard file filter specification, with each part and each pair separated by commas. Each separate pair is listed in the Files of type drop-down list box. For example, the following string specifies two file filters— text and addin: "Text Files (*.txt),*.txt,Add-In Files (*.xla),*.xla".

To use multiple MS-DOS wildcard expressions for a single file filter type, separate the wildcard expressions with semicolons; for example, "Visual Basic Files (*.bas; *.txt),*.bas;*.txt".

If omitted, this argument defaults to "All Files (*.*),*.*".

FilterIndex Optional Variant. Specifies the index numbers of the default file filtering criteria, from 1 to the number of filters specified in FileFilter. If this argument is omitted or greater than the number of filters present, the first file filter is used.

Title Optional Variant. Specifies the title of the dialog box. If this argument is omitted, the title is "Open."

ButtonText Optional Variant. Macintosh only.

MultiSelect Optional Variant. True to allow multiple file names to be selected. False to allow only one file name to be selected. The default value is False

Remarks
This method returns the selected file name or the name entered by the user. The returned name may include a path specification. If MultiSelect is True, the return value is an array of the selected file names (even if only one filename is selected). Returns False if the user cancels the dialog box.

This method may change the current drive or folder.

Example
This example displays the Open dialog box, with the file filter set to text files. If the user chooses a file name, the code displays that file name in a message box.

fileToOpen = Application _
.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then
MsgBox "Open " & fileToOpen
End If
[/more]

Цитата:

этот код какое условие проверяет?

Наличие пустых ячеек в диапазоне. Если таковых нет, то

Цитата:

выходит ошибка .что ничего не найдено для удовлетворения этого условия.

The okk
можно и без, но так с помощью Excel

pila007
В общем, там алгоритм другой в любом случае. Если делать, как ты хотел, то с Redim надо повременить - сперва неплохо бы прикинуть, сколько элементов будет в массиве (можно, конечно, в цикле делать ReDim Preserve, но уж как-то это слишком топорно). Т.е. через сколько элементов сумма будет > M. Делается без цикла в два-три действия. Сейчас соображаю туго - пятница, - поэтому точный способ сказать не могу, но задача в целом схожа с разложением десятичного числа по степеням двойки, то бишь перевод в двоичную систему.
И уже Только после этого надо делать ReDim и цикл For. А у тебя сейчас цикл в цикле для каждого элемента.

pila007
И Google им поможет. Сумма членов арифметической прогрессии
Sn = (0.5 * D * (N - 1) + A1) * N, переходя к твоему условию, осталось найти N из неравенства:
(0.5 * D * (N - 1) + A1) * N > M, где N > 0

AndVGri
извени что недогоняю, в программирование я тока новичок
а можешь по подробнее объяснить?

pila007
Подставляя в формулу A1 (первое нечётное 1) и шаг по нечётным числам D = 2, получим
N^2 > M, или N > Корень(M). Поскольку, N (число нечётных чисел в массиве, удовлетворяющее условию, целое), то число нечётных чисел сумма которых станет больше M
N = Целое(Корень(M)) + 1. Собственно то, о чём писал The okk

Спасибо всем кто помог мне в решении предыдущих проблем
Помогите ещё. Для вас я думаю что это всё очень просто, для меня пока не очень,
Приходиться постигать всё на ходу.
Задача такая:
Есть форма.на форме расположено 9 переключателей (optionButton)
Каждые три преключателя расположены во фреймах,т.е.три фрейма в каждом по три переключателя.Задача этих преключателей записывать в ячейку числа 1,2 и 3.,т.е.
Нажимаем optionButton1записываем в ячейку A1 «1»,нажимаем optionButton2записываем в ячейкуA1 «2» ну и соответственно optionButton3 записываемВ А1 «3»
Это на первом фрейме.На втором и на третьем фрейме тоже самое, только цифры 1,2 и 3 записываются соответственно в ячейку A2 и A3.Прописываю в каждом переключателе на
Событии «Клик» такой код : Range ("A1").Value = "1"во втором Range ("A1").Value = "2"
В третьем Range ("A1").Value = "3" ну и т.д.на других фреймах.Загружаю форму .Сначала вроде всё устанавливается , а потом вдруг всё начинает зависать.Наверное что-то не так у меня. Это первое.Второе мне нужно, чтобы при открытии формы все установки переключателей сохранялись в таком положении в котором я их установил.Стал использовать код при закрытии формы UserForm1.Hide.Вроде всё остаётся ,но если загрузить форму и нажать X(закрытие)формы то все установки соответственно пропадают.
Наверное нужно что-то прописать в событии формы «Activate» я так мыслю.Например
If Range("A1").Value = "1" Then
UserForm1.OptionButton1.Value = True
Но мне кажется что это всё как то примитивно,да и слишком будет много прописывать, как то тут наверное всё можно записать более солидно.Вообщем помогите новичку.

GFSGF

Цитата:

Сначала вроде всё устанавливается , а потом вдруг всё начинает зависать.Наверное что-то не так у меня

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

Цитата:

стал использовать код при закрытии формы UserForm1.Hide.

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

Цитата:

Но мне кажется что это всё как то примитивно

Ничуть
Как вариант

Код:
Select Case Range("A1").Value
Case 1: OptionButton1.Value = True
Case 2: OptionButton2.Value = True
Case 3: OptionButton3.Value = True
Case Else
MsgBox "Где-то ошибка, однако"
End Select

Всем привет! подскажите как в excel сделать следующее: есть информация представленная в виде 50.00 р, 100.00 р....мне нужно чтобы эта инфо преобразовалась в денежную формат (50,00 р, 100,00 р). все перепробывал....помогите пожалуйста!?!?

Firstik
Поиск и замена точки на запятую. Затем устанавливаешь формат для получившихся чисел в денежный
Вопрос для Excel FAQ

AndVGri
спасибо за умную мысль......
огромное спасибо!!