» Excel VBA (часть 2)

CEMEH
если ЧЕСТНО ... НЕ понял ...
хотя МОЖЕТ быть интересно ...
и ... МИНИМАЛЬНЫЙ ... отдых ... это КАКОЙ?

и ... не получается ли для ОБРАТНОГО отправления ставить номера бригад последовательно ... начиная с 1-ой бригады в 11-30, 2-ой в 14-00 и ТАК далее?

Минимальный отдых это разница между временем отправления и значением "вилки" " минимум"
Если начать подвязку первую бриаду на 11:30 и так далее то при одной из последующих подстановок произойдет сбой (например при очередных значениях "вилки" время отправления поезда раньше минимально возможного) . После этого надо будет произвести циклический сдвиг на значение +1 (то есть 1-ю бригаду подвязывать уже на 14:00. У нее, конечно отправление позже максимального значения вилки, но это не смертельно. Затем опять подставлять значения попорядку до тех пор, пока опять не встретится ошибка. и тогда опять сдвинуть на +1. Интересен процесс создания алгоритма этого сдвига. Но самое главное суметь доказать, что подобный подбор самый оптимальный и другие варианты будут только хуже.
Я хотел составить таблицу всех возможных вариантов подбора бригад. Запустить макрос и пересчитать. Потом оставить вариант с самыми лучшими показателями.

Не работает функция вида
Function sss(m, n)
S = EoMonth(m, n)
sss = S
End Function
Выдает ошибку "Compile error: Sub or Function not defined"
Что не так?

АПДЕЙТ: уже сам разобрался.

ВОПРОС:

Есть два столбца с числами
в первый они записаны изначально
1
2
3
4
...
20

во второй столбец числа вводить руками но есть определенные условия
1. Отсутствующие числа (1...20) во втором столбце будут подсвечены красным цветом в первом столбце.
2. Повторяющиеся числа второго столбца будут подсвечены красным (во втором столбце)

Наверное макросом это сделать не сложно. А можно обойтись без макроса? Использовать условное форматирование.

ВОПРОС РЕШЕН! Надо условное форматирование заряжать формулой =счётесли($B:$B;B)>1 подсветит дубликаты, а индекс(поискпоз - подсветит отсутствующие значения

Насчет второго: условное форматирование - правило выделения - повторяющиеся (это в 2007).
Насчет первого - может быть, через сравнение массивов... но хз как. Может, свою функцию?

Ребят, проблема. Помогите советом...

Есть книга, в которой поле

"Ксента, 0,700л. 70.0%, Box + 2 стакана и ложка" ( ТЕКСТ, ЧИСЛОл. ПРОЦЕНТ, ТЕКСТ - такой формат записей.)

Нужно разбить это поле так:

"Название" "Объём" "Крепость" "Дополнение", например

"Ксента" "0,700л" "70.0%", "Box + 2 стакана и ложка"

Как такое сделать?

alex_gall
Вот здесь посмотрите.

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

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

Здравствуйте, уважаемый all.
Подскажите новичку как на уровне команд VBA выполнить копирование ЗНАЧЕНИЙ из ячеек одного листа в соответствующие ячейки на другом листе?
Спасибо!

maloy15, Вы не поверите, но задача имеет множество решений и реализаций - всё зависит от конкретных условий...
ну, просто для затравки (скопировать диапазон B1:D19 с текущего листа на лист с именем "Лист3":
Код:
Range("B1:D19").Copy ThisWorkbook.Sheets("Лист3").Range("B1")

Спасибо.
А если нужно на лист «Вывод» копировать с листа «Импорт» только те строки, у которых значения в 45-м столбце больше чем в ячейчке B1 листа «Данные». Вот такая конструкция
Sub test3()
Sheets("Импорт").Select
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(i, 45).Value > Sheets("Данные").Cells(1, 2) Then ActiveSheet.Rows(i).copy Sheets("Вывод")
Next
End Sub

завершается по ошибке: «Метод Copy из класса Range завершен неверно» и далее по дебагу выделяется желтым строка ActiveSheet.Rows(i).copy Sheets("Вывод")

Подскажите в чем ошибка?

SERGE_BLIZNUK
эх, спасибо, дорогой человек, уже в который раз выручаешь в этом нелёгком деле...

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


добавлено:
я кажись разобрался. сменил With ThisWorkbook.Worksheets(1) на With ActiveWorkbook.Worksheets(1)
незнаю правда, так правильно или нет...

maloy15

Цитата:

выделяется желтым строка ActiveSheet.Rows(i).copy Sheets("Вывод")

ошибка как раз в этой строке :-)) вы забыли указать, куда же выводить (куда, кстати,
ну, что на лист "Вывод" понятно, а в какую строчку?!
Надо указать что-то вроде:
Код:
Dim k As Integer, i As Integer
Sheets("Лист1").Select
k = 1
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Cells(i, 45).Value > Sheets("Данные").Cells(1, 2) Then
ActiveSheet.Rows(i).Copy Sheets("Лист3").Rows(k)
k = k + 1
End If
Next i

Все получилось, цикл переделал в другую сторону, это все по неумению было. Большое вам спасибо, Serge_Bliznuk, за науку!!!

Добрый день.
Столкнулся с необходимостью при нажатии кнопки в Экселе, послать сочетание клавиш ctrl+d в одно из окон другой программы. Или же выделить окно в другой программе и нажать кнопку в ней на панеле.

Уже нашел что-то похожее Найти "чужое" окно и нажать в нем кнопку Но вот как послать именно сочетание клавиш разобраться не могу.

Спасибо!

Averry
См. help, инструкция SendKeys.

Averry
ClassName и Caption можно получить при помощи маленькой бесплатной программы InqSoft Window Scanner.

ребят перевожу ~500 юзеров в новый домен. у юзера раньше был логин ivaii (Иванов Иван Иваныч), новый будет ivanovii. Как в Excel сделать генерацию по ФИО? т.е. из строки ФИО - фамилию конвертить в латиницу, а с имени и отч. брать только первую букву и тож конвертить в латиницу. Вообще возможно ли это?
Заранее спасибо

Здравствуйте, помогите разобраться.
Есть массив (размер его может меняться). Необходимо найти конец 3-го столбца и в следующей пустой ячееке вставить формулу суммирования всех ячеек этого стобца

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

Использовать так Петров Николай Николаевич    =ConvertFIO(A2) результат petrovnn

[more=Программа]
'конвертит все символы в строчке
Function latinStr(ByVal sStr As String)
Dim iCount, i As Integer
Dim sChar As String
Dim Res As String
Dim ByCode As Integer


Res = ""
iCount = Len(sStr)
For i = 1 To iCount Step 1
sChar = Mid(sStr, i, 1)
Select Case sChar
Case "ф", "Ф"
Res = Res + "f"
Case "ы", "Ы"
Res = Res + "i"
Case "в", "В"
Res = Res + "v"
Case "а", "А"
Res = Res + "a"
Case "п", "П"
Res = Res + "p"
Case "р", "Р"
Res = Res + "r"
Case "о", "О"
Res = Res + "o"
Case "л", "Л"
Res = Res + "l"
Case "д", "Д"
Res = Res + "d"
Case "ж", "Ж"
Res = Res + "j"
Case "э", "Э"
Res = Res + "e"
Case "й", "Й"
Res = Res + "y"
Case "ц", "Ц"
Res = Res + "c"
Case "у", "У"
Res = Res + "u"
Case "к", "К"
Res = Res + "k"
Case "е", "Е"
Res = Res + "e"
Case "н", "Н"
Res = Res + "n"
Case "г", "Г"
Res = Res + "g"
Case "ш", "Ш"
Res = Res + "h"
Case "щ", "Щ"
Res = Res + "ch"
Case "з", "З"
Res = Res + "z"
Case "х", "Х"
Res = Res + "h"
Case "ъ", "Ъ"
Res = Res + ""
Case "я", "Я"
Res = Res + "y"
Case "ч", "Ч"
Res = Res + "ch"
Case "с", "С"
Res = Res + "s"
Case "м", "М"
Res = Res + "m"
Case "и", "И"
Res = Res + "i"
Case "т", "Т"
Res = Res + "t"
Case "ь", "Ь"
Res = Res + ""
Case "б", "Б"
Res = Res + "b"
Case "ю", "Ю"
Res = Res + "u"
End Select
Next
latinStr = Res
End Function

'выделяем фамилию имя отчество и конвертит
Function ConvertFIO(ByVal sBuff As String)
Dim sF, sI, sO As String
Dim pos As Integer
sBuff = Trim(sBuff)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos < 1 Then
ConvertFIO = "error"
Return
End If
sF = Left(sBuff, pos - 1)
sBuff = Mid(sBuff, pos + 1)
pos = InStr(1, sBuff, " ", vbTextCompare)
If pos > 0 Then
sI = Left(sBuff, 1)
sO = Mid(sBuff, pos + 1, 1)
End If
ConvertFIO = latinStr(sF) & latinStr(sI) & latinStr(sO)
End Function
[/code]
[/more]

maloy15

Цитата:

Есть массив (размер его может меняться). Необходимо найти конец 3-го столбца и в следующей пустой ячееке вставить формулу суммирования всех ячеек этого стобца

1. Присвоить имя массиву, напр. Name1
2. Макрос

Код:
Sub GetEnd()
Dim r As Integer

With Range("Name1")
r = .Rows.Count
Set cc = .Cells(1, 1).Offset(r, 2)
End With
cc.Formula = "=SUM($C$1:$C$" & r & ")"

End Sub

maloy15
Если учесть что место поиска вся используемая область и отсчет берем с первого заполненого столбца то можно так [more=Текст]
Код: Dim Rng As Range, cel As Range
Dim cSheet As Worksheet

Set cSheet = Application.ActiveSheet
Set Rng = cSheet.UsedRange
If (Rng.Rows.Columns.Count < 3) Then
MsgBox "нехватает столбцов до заданного количества"
Return
End If

Set cel = Rng.Cells(Rng.Rows.Count, 3)
Rng.Cells(Rng.Rows.Count + 1, 3).FormulaR1C1 = "=SUM(" & Rng.Columns(3).Address(ReferenceStyle:=xlR1C1) & ")"

Здравствуйте! Я только начала учиться программировать на vba и столкнулась вот с какой проблемой - в excel выделен диапазон. Необходимо записать в массив значения, хранящиеся в этих ячейках. Я знаю как это выполнить если выделен диапозон без разрыва. Но вот если выделен с разрывом (например ячейки А1, А4, А17), то он заполняет только значение из ячейки А1, на остальные даже не переходит Помогите решить проблему...
P.S. Извините, если этот вопрос уже обсуждался, просто сложно обработать такое количество информации

littlevitch

Код: Sub Macr()
Dim MyArray() As Integer
Dim j As Integer
ReDim MyArray(Selection.Count)
For j = 1 To Selection.Count
MyArray(j) = Cells(j, 1)
Next j
End Sub

я делаю так:

Dim cur_range As Range
Dim mass() As Integer
Dim flag As Integer
Dim i As Integer

With ActiveSheet
Set cur_range = Selection

cur_range.Activate
For x = 1 To cur_range.Rows.Count
'For y = 1 To cur_range.Columns.Count
r = Str(cur_range(x, 1).Value)
flag = flag + 1
ReDim Preserve mass(0 To flag)
mass(flag - 1) = r
'Next y
Next x
End With

To Vitus_Bering:
Пробовала предложенный Вами код. Почему-то когда мы выделяем А1, А4, А8 например, он записывает в массив значения ячеек А1,А2,А3...

littlevitch

Код: Sub Macr()
Dim MyArray() As Integer
Dim j As Integer
j = 0
ReDim MyArray(Selection.Count)
For Each rng In Selection
j = j + 1
MyArray(j) = rng
Next rng
End Sub

RedPromo


Цитата:

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

Использовать так Петров Николай Николаевич =ConvertFIO(A2) результат petrovnn

Программа

Идеально для админов, огромное спасибо.

Кто-нибудь пробовал делать пользовательские функции Excel из материала на http://www.delphikingdom.com/asp/viewitem.asp?catalogid=412
"Склонение фамилий, имен и отчеств по падежам Библиотека функций." ?

Никак не получается: #ИМЯ?, в всё...

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

Буду искренне и глубоко благодарен ЛЮБОЙ помощи!! :_ _ -)

VseImenaPereproboval
Если можно поконкретнее в чем проблема, ты используеш свою функцию или из библиотеки. Ссылка на пользовательские функции и представленная там библиотека нормально функционирует, склоняет все в Excel прекрасно. Скорее всего у тебя не находит файл библиотеки Padeg.dll.

Согласен с RedPromo, всё работает.