Ребята, нужна помощь.

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Beckham
Сообщения: 2
Зарегистрирован: 17 дек 2009, 18:43

В универе дали задание написать 2 простеньких макроса для Word и Excel на VBA, но, так как я учусь на механико-машиностроительном факультете, нас этому естественно не учили. Поэтому, уважаемые программисты, нужна ваша помощь!

1. Word
Найти в документе слова с окончаниями тся и ться. Выделить окончания тся синим цветом, а ться — красным.

2. Excel
Имеется столбец с числами. Создать второй столбец, в котором числа идут в обратном порядке. Высота исходного столбца чисел заранее неизвестна.

Заранее прошу прощения за просьбу о помощи, привык все делать сам, но тут времени много нужно для изучения с нуля. Это как если бы вам задали начертить простенький 1-ступенчатый редуктор))
Teslenko_EA
Сообщения: 526
Зарегистрирован: 04 фев 2007, 18:37
Откуда: Сургут
Контактная информация:

Здравствуйте Beckham.
Со второй задачей поможет справиться размещенная в модуле подобная функция:

Код: Выделить всё

Function rev(v)
    rev = CDbl(StrReverse(v))
End Function
её применение может выглядеть так: =rev(H3)
Евгений.
Beckham
Сообщения: 2
Зарегистрирован: 17 дек 2009, 18:43

Спасибо большое, но я не знаю, что значит "эта функция может быть вызвана =rev(H3)", а при вставке в модуль просто функции, она ничего не делает, так как макрос не работает без процедуры.
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

2.
Вот весь код:

Код: Выделить всё

[color=darkblue]Sub[/color] test()
    [b:b].ClearContents    [color=green]' очистка 2-го столбца[/color]
    ПоследняяСтрока = Range("A" & Rows.Count).End(xlUp).Row
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] ПоследняяСтрока
        Cells(i, 2) = Cells(ПоследняяСтрока - i + 1, 1)
    [color=darkblue]Next[/color] i
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
Пример файла:

Изображение
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
С Word-ом ещё проще - достаточно воспользоваться макрорекордером:

Код: Выделить всё

Sub Макрос1()
    With ActiveDocument.Range.Find
        .Format = True
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = [color="Blue"]wdColorBlue[/color]
[B]        .Text = "тся ": .Replacement.Text = "тся "[/B]
        .Execute Replace:=wdReplaceAll

        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = [color="Red"]wdColorRed[/color]
[B]        .Text = "ться ": .Replacement.Text = "ться "[/B]
        .Execute Replace:=wdReplaceAll
    End With
    Selection.HomeKey Unit:=wdStory
End Sub
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
Damien666
Сообщения: 2
Зарегистрирован: 21 дек 2009, 03:25

Здраствуйте, у меня аналогичная ситуация, помогите плиз кому не трудно

задание по Exel
Имеется столбец целых чисел от 1 до 10 (высота столбца заранее неизвестна). Записать в ячейку B2 количество вхождений в столбец заданного числа X. Число X записано в ячейку B1

по Word
Заменить в документе каждое пятое слово, не считая слов, состоящих менее чем из трёх букв, на многоточие

Решить надо написанием макроса

по exel нашел вот такой макрос

[

Код: Выделить всё

Sub Macroz()

On Error Resume Next
Dim cc As Range, se As Range, n As Long
Columns("B:C").Clear
Set se = Range(Cells(1, 1), Cells(Columns(1).Cells.Count, 1).End(xlUp))
For Each cc In se.Cells
If WorksheetFunction.CountIf(se, cc.Value) > 1 Then
If WorksheetFunction.CountIf(se.Offset (0, 1), cc.Value) < 1 Then
n = n + 1
Cells(n, 2) = cc.Value
Cells(n, 3) = WorksheetFunction.CountIf(se, cc.Value)
End If
End If
Next cc


End Sub
помогите его иправить чтобы он соответствовал моему заданию, т.е. выдавал количество поторений только заданного значения.

Заранее спасибо!
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

по Excel
http://www.programmersforum.ru/showpost ... ostcount=2


по Word

Код: Выделить всё

Sub test()
    Dim p As Paragraph, w As Range
    For Each p In ActiveDocument.Paragraphs
        i = 0
        For Each w In p.Range.Words
            If w.ComputeStatistics(wdStatisticCharacters) > 3 Then i = i + 1
            If i = 5 Then w.Text = "... ": Exit For
        Next w
    Next p
End Sub
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
maks585
Сообщения: 2
Зарегистрирован: 21 дек 2009, 17:00

Помогите пожалуйста, вот такое задание!!

VBA Word
В каждом слове текущего предложения изменить порядок букв на обратный.

VBA Excel
Кусочно-линейная функция f(x) представлена в виде таблицы, состоящей из двух одинаковых по высоте столбцов чисел. В первом столбце находятся значения x, во втором — значения f. Значения x строго монотонно возрастают. Высота столбцов n заранее неизвестна, но она точно больше одного (таким образом, задан как минимум один линейный участок). Создать третий столбец высоты n, содержащий значения интеграла от f(x) по x от самого первого значения x до текущего значения x.

Заранее спасибо!
akunin
Сообщения: 1
Зарегистрирован: 21 дек 2009, 17:30

Та же проблема... кому не трудно...
MS Word : Все нечетные абзацы кратные трем необходимо окрасить в красный цвет...
MS EXCEL: Из столбца неизвестной длины перенести в другой столбец 3 наибольших по модулю числа...
Аватара пользователя
EducatedFool
Сообщения: 197
Зарегистрирован: 06 апр 2008, 14:03
Откуда: Россия, Урал
Контактная информация:

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

Если готовы заплатить за решение задач - обращайтесь в аську (контакты в профиле)
Макросы для Excel, Word, CorelDRAW. Быстро, профессионально, недорого. http://ExcelVBA.ru/

Благодарности принимаются на кошелёк WebMoney: R318574877619 и Яндекс.Деньги: 41001335672216
Damien666
Сообщения: 2
Зарегистрирован: 21 дек 2009, 03:25

Спасибо за помощь, и извини за беспокойство...
Ответить