» Excel VBA (часть 2)

MaximuS G
Если я правильно понял вопрос, то нужно ко всем ячейкам окрашенным в синий цвет из диапазона А1:С20 применить одновременно какое-то свойство, например сделать текст этих ячеек жирным? Так?
Excel не может выдать такую информацию мгновенно т.к. она не существует. Поэтому чтобы выбрать все синии ячейки придется перебором проверять свойство через FOR-Next и набирать ссылки ячеек в текстовый массив неопределенной длины. После этого перебирая массив применяем для каждой ячейки жирный шрифт.
Вот и все! делов-то на три копейки

visual73
ну МОЖНО и чуть в другую сторону ...

Dim rn As Range

x = 0

For Each rn In Selection
If rn.Interior.ColorIndex = 5 Then
x = x + 1
End If
Next

MsgBox ("Всего " & x & " синих ячеек!!")

вместо Selection можно что угодно прилепить ...
PS для СИНЕГО цвета interior.colorindex = 5

visual73
WowGun
Спасибо ребята, но я это уже СДЕЛАЛ!!! (2ва варианта)
Хочу ОДНОВРЕМЕННО менять шрифт !!! Скажите, кто-нибудь, такое вообще возможно ?

Блин, не дает этот вопрос спокойно сидеть
Всем

Цитата:

Поэтому чтобы выбрать все синии ячейки придется перебором проверять свойство через FOR-Next и набирать ссылки ячеек в текстовый массив неопределенной длины. После этого перебирая массив применяем для каждой ячейки жирный шрифт.

А вот я предполагаю не перебирать массив обратно и закрашивать, а каким то образом сразу закинуть значение элементов массива в union, но как-то в обход, потому что элементы массива arr(i) = selection.address - текстовый тип, а в union все типы range...

MaximuS G

Dim rn As Range
Dim rnn As Range
x = 0

For Each rn In Selection
If rn.Interior.ColorIndex = 5 Then

If x = 0 Then
Set rnn = rn
Else
Set rnn = Union(rnn, rn)
End If
x = 1
End If
Next

rnn.Font.Bold = True


и ЧЕМ это лучше?

WowGun
Ха! Спасибо! Супер!
Я не говорил, что это способ ЛУЧШЕ или УДОБНЕЙ !!!
Я же учусь - это только способ обучения... вот например я бы нескоро додумался работать с объектными переменными, причем засовывая один Union в другой !!!
Спасибо еще раз!

Mont1
Спасибо

Цитата:

и ЧЕМ это лучше?

Гы! Дейвствительно получается что в уме все выделяется а потом разом красится, но выделяется все равно по ОДНОЙ ячейке. Можно было просто отключить обновление экрана залить все потихому и включить обновление. воть.

Для проверки бы загрузить бы чем нибудь оба способа и проверить через Timer. воть.

q1wed
По мне так все равно интересно сделано...

Такой вопрос КО ВСЕМ: можна ли программно изменить цвет индикатора примечания ?
Только что спросил тоже самое на форуме для пользователей, но думаю для пользователя такой возможности не предусмотрено..

MaximuS G
такое предусмотрено только для программистов Microsoft

q1wed

:u)

для 1-го варианта
20 000 выделенных ячеек, каждая вторая закрашена - 2 секунды

для 2-го варианта
5 000 выделенных ячеек, каждая вторая закрашена - 48 секунд

гы-гы ... (обновление экрана НЕ отключалось)

помогите решить задачу через "поиск решений"
у меня есть три не известных
x1, x2, x3 - целые числа
условия задачи
x1+x2+x3=8
целевая функция
54*x1+67,5*x2+45*x3 стремится к максимому
чета сегодня туплю, не могу я понять
если кто решит скиньте мне плиз сам экселевский файл

уже все разобрался

Цитата:

для 1-го варианта
20 000 выделенных ячеек, каждая вторая закрашена - 2 секунды

для 2-го варианта
5 000 выделенных ячеек, каждая вторая закрашена - 48 секунд

да уж...

q1wed
WowGun
Получается лучше перебирать по-порядку... Наверное так замедляют систему объектные переменые... Хотя тогда интересно, как же программа выделяет например пустые ячейки одновременно через метод "SpecialCells(xlCellTypeBlanks).Select" , что намного быстрее чем перебирать и искать пустые... наверное из-за типа xlCellType...

Всем привет! Подскажите как можно попростому преобразовать содержимое ячеек вида
Корица 00125
Гвоздика 07645
Стружка кокосовая 01161

в
Корица
Гвоздика
Стружка кокосовая

тоесть отбросить последние 5 или 6 символов. Такой встроеной функции не нашел.

Цитата:

Всем привет! Подскажите как можно попростому преобразовать содержимое ячеек вида

примерно так =ЛЕВСИМВ(A1;(ДЛСТР(A1)-6))

miha7411
Dim slovo, isk As String
Dim dlina, position As Long

slovo = "Корица 00125"
dlina = Len(slovo)
position = InStr(slovo, " ")
isk = Left(slovo, position - 1)
MsgBox isk

Цитата:

MaximuS G

ага, а на "Стружка кокосовая 01161" получится "Стружка"

DonRus
MaximuS G
Спасибо вам. Направление усек. Первый вариант подходит.

DonRus
... а на Стружка 01161155 получиться Стружка 011 ... где гарантия что символов будет 6 ? Или 5 ? Только что посмотрел, нет функции для поиска с конца.. Макрос должнем быть примерно таким, только пусть гуру подскажут почему у меня функция Instrrev и Instr возвращают одинаковую позицию, хотя одна ищет с конца а другая с начала ...


Dim slovo, isk As String
Dim dlina, position As Long

slovo = "Êîðèöà fgfgdgfadr"
dlina = Len(slovo)
position = InStrRev(slovo, " ")
isk = Left(slovo, dlina - position)



Добавлено:
Всем
Дайте кто-нибудь консультацию относительно функции InStrRev, как сделать что бы эта функция начинала поиска с КОНЦА, я уже одурел, час мудохаюсь, на всех сайтах написано что должна возвращать с конца, а у меня нифига (


Добавлено:
miha7411
Все!!! Кароче эта функция глюковатая какая-то, в составе другой функции работает, а сама по себе нет... Бред!
Вот этот код подойдет к любому слову

slovo = "dfdf dfasaa fdf"
nslovo = Mid(slovo, InStrRev(slovo, " ") + 1)
MsgBox nslovo

MaximuS G
Не заморачивайся, вот так у меня работает в макросе
Var1 = Left(Range("A11"), Len(Range("A11")) - 6)
Мне надо именно постоянное количество символов отбрасывать.
Еще раз спасибо откликнувшимся за помощь!

Вот так кстати тоже прекрасно работает, тут действительно последнее слово может быть различной длины,
критерий обрезания - последний пробел:
Sub Макрос()
slovo = "dfdf dfasaa fdf"
nslovo = Mid(slovo, 1, InStrRev(slovo, " ") - 1)
MsgBox nslovo
End Sub

Обычная форма. Пытаюсь уменьшить размеры. Уменьшает до высоты (Height) 27. Дальше никак, а нужно уменьшить где-то до 15 (для маленьких кнопочек). Может есть спец.библиотеки для таких маленьких кнопочек?

Через Win API это точно можно сделать. Может кто-нибудь подсказать код?

Столкнулся с проблемой, помогите решить.

Нужно пройтись по всем ячейкам в таблице и программно нажать F2 (редактирование ячейки)

Проблема связана с импортом во внешнюю базу (неправильно определяется тип данных (нужно текстовый формат))


Спасибо

ivan76
А не проще будет отформатировать все ячейки в текстовый формат?
Cells.Select
Selection.NumberFormat = "@"

ivan76

Цитата:

Нужно пройтись по всем ячейкам в таблице и программно нажать F2 (редактирование ячейки)

или, если совет dneprcomp не помог, выложите маленький пример XLS файла с "неправильными" форматами ячеек (буквально пары-тройки ячеек будет достаточно).
Думаю, что смогу помочь с готовым макросом.

SERGE_BLIZNUK
dneprcomp


Спасибо за оказанную помощь!

Проблему решил так:

Dim cel As Range
Dim rng As Range

Set rng = Worksheets(1).Range("A:A")
rng.NumberFormat = "@"

For Each cel In rng
cel.Value = Trim(cel.Text)
Next



Не понял как прикреплять вложения на форуме.
Вырезку из файла выложил на http://narod.ru/disk/4261692000/Example.rar.html

Очень интересные данные)

Как можно в книге Excel сделать сделать гиперссылку на другой лист с помощью кнопки (MsgBox)?

Alex209

Цитата:

сделать гиперссылку на другой лист с помощью кнопки (MsgBox)?

Что значит с помощью кнопки (MsgBox)?
Если ты имеешь в виду с помощью макроса, попробуй команду
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Лист2!R1C1", TextToDisplay:="Лист2!R1C1"

Спасибо за ответ.
Применил эту команду в такой конструкции:

Private Sub CommandButton1_Click()
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Лист4!R1C1", TextToDisplay:="Лист4"
End Sub

При нажатии на кнопку, на листе появляется ссылка на лист 4 и только при нажатии на эту ссылку происходит переход на лист 4.

Я бы хотел, чтобы:
1. переход на другой лист происходил непосредственно при нажатии на кнопку;
2. и адрес листа задавался бы не его порядковым номером в книге (SubAddress:="Лист4!R1C1"), а именем листа.

Буду признателен за помощь

Уважаемые, подскажите пожалуйста в чем ошибка?
Мне нужен Макрос для ранжирования строк(поднять строку вверх, т.е. простая замена ячеек местами, столбцов C и D) сочетанием клавиш, но таким образом чтоб нумерация в первом столбце (B - Приоритет) не менялась, и формулы в Столбце E пересчитывались(в столбце Е привел формулы и результат).

| A | B | C | D
1 |Планы расходов. |Бюджет:|7385 |руб
2 |Приорите|Необходимо |Цена |Остаток
3 | 1 |Набор резцов|2000 |=D1-C3=5385
4 | 2 |Фоторамки |600 |=D3-C4=4785
5 | 3 |Привод DVD |900 |=D4-C5=3885
6 | 4 |HDD 300Гб |2500 |=D5-C6=1385


Sub SelectedUP()
'
' SelectedUP Макрос
' Макрос записан 18.10.2008 (Radmir)
'
' Сочетание клавиш: Ctrl+u
'
Dim UpRow As Integer

UpRow = Selection.Row

Range(Cells(UpRow, 2), Cells(UpRow, 3)).Select
Selection.Formula.Cut Destination:=Range("I1:J1")
Range(Cells(UpRow - 1, 2), Cells(UpRow - 1, 3)).Select
Selection.Formula.Cut Destination:=Range(Cells(UpRow, 2), Cells(UpRow, 3)).Formula
Range("I1:J1").Select
Selection.Formula.Cut Destination:=Range(Cells(UpRow - 1, 2), Cells(UpRow - 1, 3)).Formula

End Sub

Ошибка:
Run-time error '424'
object required

Когда у меня был код по проще, у меня смена местами получалась, но результаты формул Остатков не менялись, так как менялись сами формулы, как бы привязываясь к строкам.

Добавлено:
Я внес изменения: убрал .Formula, чтоб Макрос оперировал с Ячейками... Но Остатки всё же не пересчитываются... Пытаюсь решить и эту проблему, но пока сам не справляюсь.

Sub SelectedUP()
'
' SelectedUP Макрос
' Макрос записан 18.10.2008 (Radmir)
'
' Сочетание клавиш: Ctrl+u
'
Dim UpRow As Integer

UpRow = Selection.Row

Range(Cells(UpRow, 2), Cells(UpRow, 3)).Select
Selection.Cut Destination:=Range("I1:J1")
Range(Cells(UpRow - 1, 2), Cells(UpRow - 1, 3)).Select
Selection.Cut Destination:=Range(Cells(UpRow, 2), Cells(UpRow, 3))
Range("I1:J1").Select
Selection.Cut
Range(Cells(UpRow - 1, 2), Cells(UpRow - 1, 3)).Select
ActiveSheet.Paste

End Sub