Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.80/15: Рейтинг темы: голосов - 15, средняя оценка - 4.80
0 / 0 / 0
Регистрация: 02.11.2012
Сообщений: 3

Даны натуральные числа n, m. Получите все меньшие n натуральные числа

02.11.2012, 21:31. Показов 2895. Ответов 3
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Здравствуйте! Помогите с программой в VBA: даны натуральные числа n,m. получите все меньшие n натуральные числа, квадрат суммы цифр которых равен m. (n -трёхзначное, m - двухзначное).
0
cpp_developer
Эксперт
20123 / 5690 / 1417
Регистрация: 09.04.2010
Сообщений: 22,546
Блог
 02.11.2012, 21:31
Ответы с готовыми решениями:

Найти все натуральные числа n, меньшие 30/
Найти все натуральные числа п, меньшие 30, для которых (2n - п) кратно 7.

Даны натуральные числа р и q. Получить все делители числа q, взаимно простые с р. VBA
. Даны натуральные числа р и q. Получить все делители числа q, взаимно простые с р. Помогите сделать задание..

На отрезке [2, п] найти все натуральные числа, сумма цифр которых при умножении числа на а не изменится
На отрезке найти все натуральные числа, сумма цифр которых при умножении числа на а не изменится.

3
 Аватар для Sasha_Smirnov
5562 / 1370 / 150
Регистрация: 08.02.2009
Сообщений: 4,109
Записей в блоге: 30
03.11.2012, 05:34
Как в тему оказалась тема Вычислить, чему равна сумма цифр числа (2-й пост, от Казанского)!

Цитата Сообщение от Dragokas Посмотреть сообщение
Казанский, неужто на пальцах считал
Даже если и считали в уме — теперь не надо, ибо есть
Visual Basic
1
2
3
4
5
6
7
8
9
10

Sub Irin()
    For i = 0 To 999
        s = 0
        k = Len(i)
            For p = 1 To Len(i)
               s = s + Mid(i, p, 1)
            Next
        Selection.TypeText s & ", " & IIf(i Mod 100 = 0, "_ " & Chr(13), "")
    Next
End Sub
Благодаря которому возникла такая вот незамысловатая функция суммы цифр для чисел [1; 999]:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

Function SumCifNatNumBefore1000(x) As Integer
If Not IsNumeric(x) Then SumCifNatNumBefore1000 = 0: Exit Function 'даёт 0, когда икс не число
If Fix(x) <> x Then SumCifNatNumBefore1000 = 0: Exit Function 'даёт 0, когда икс нецелое число
If x < 1 Or x > 999 Then SumCifNatNumBefore1000 = 0: Exit Function
 
SumCifNatNumBefore1000 = Array(0, _
    1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 1, _
    2, 3, 4, 5, 6, 7, 8, 9, 10, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 2, _
    3, 4, 5, 6, 7, 8, 9, 10, 11, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 3, _
    4, 5, 6, 7, 8, 9, 10, 11, 12, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 4, _
    5, 6, 7, 8, 9, 10, 11, 12, 13, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 5, _
    6, 7, 8, 9, 10, 11, 12, 13, 14, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 6, _
    7, 8, 9, 10, 11, 12, 13, 14, 15, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 7, _
    8, 9, 10, 11, 12, 13, 14, 15, 16, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 8, _
    9, 10, 11, 12, 13, 14, 15, 16, 17, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 9, _
    10, 11, 12, 13, 14, 15, 16, 17, 18, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27) _
(x)
End Function


И она успешно использована в решении.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12

Sub Iri()
Const n = 999   'трёхзначное целое
Const m = 64    'целое, желательно полный квадрат (1, 4, 9, 16, 25, ...)
Const d = 2     'степень, в которую требуется возводить сумму цифр
Dim s, i
 
    For i = 1 To n
    If SumCifNatNumBefore1000(i) ^ d = m Then s = s & " " & i
    Next
    
    MsgBox IIf(s = "", "‹нет›", s), , d & "-я степень суммы цифр равна " & m & " у:"
End Sub
Исправлено через 2 часа 34 минуты (!)
1
 Аватар для Alex77755
11525 / 3812 / 683
Регистрация: 13.02.2009
Сообщений: 11,229
03.11.2012, 09:43
Благодаря которому возникла такая вот незамысловатая функция суммы цифр для чисел [1; 999]:

Не по теме:

Предлагаю расширить незамысловатую функцию хотя бы до 1 000 000

1
0 / 0 / 0
Регистрация: 02.11.2012
Сообщений: 3
05.11.2012, 17:00  [ТС]
Спасииибо огромное!!!!
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
raxper
Эксперт
30234 / 6612 / 1498
Регистрация: 28.12.2010
Сообщений: 21,154
Блог
 05.11.2012, 17:00
Помогаю со студенческими работами здесь

Даны натуральные числа M и N.определить период десятичной дроби m/n
Даны натуральные числа M и N.определить период десятичной дроби m/n

Найти все натуральные числа n меньше 30
Найти все натуральные числа n меньше 30 для которых (2^n-n) кратно 7

Найти все натуральные числа палиндромы
Помогите. Нужно найти все симметричные натуральные числа ( палиндромы ) из интервала от К до L. VBA Word

Даны натуральные число n, действительные положительные числа. Определить оценку, которая пойдет в зачет спортсмену

Найти все натуральные числа, представимые в виде суммы трех квадратов натуральных чисел
Найти все натуральные числа n(2&lt;n&lt;40), представимые в виде суммы трех квадратов натуральных чисел (n = х^2 + у^2 + z^2). Указать сами числа...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
4
Ответ Создать тему
Новые блоги и статьи
Программный контроль заполнения реквизита табличной части документа
Maks 02.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой
Maks 02.04.2026
Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/
Программная установка даты и запрет ее изменения
Maks 02.04.2026
Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .
Вывод данных в справочнике через динамический список
Maks 01.04.2026
Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .
Программное заполнения текстового поля в реквизите формы документа
Maks 01.04.2026
Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .
К слову об оптимизации
kumehtar 01.04.2026
Вспоминаю начало 2000-х, университет, когда я писал на Delphi. Тогда среди программистов на форумах активно обсуждали аккуратную работу с памятью: нужно было следить за переменными, вовремя. . .
Идея фильтра интернета (сервер = слой+фильтр).
Hrethgir 31.03.2026
Суть идеи заключается в том, чтобы запустить свой сервер, о чём я если честно мечтал давно и давно приобрёл книгу как это сделать. Но не было причин его запускать. Очумелые учёные напечатали на. . .
Модель здравосоХранения 6. ESG-повестка и устойчивое развитие; углублённый анализ кадрового бренда
anaschu 31.03.2026
В прикрепленном документе раздумья о том, как можно поменять модель в будущем
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru