» Задачи на Visual Basic (VB).

ОГРОМНОЕ СПАСИБИЩЕ!!!

Molvino

Цитата:

Забача №2
...
Для вывода массива пользоваться элементом управления LIST

оО
Что в листбокс-то выводится?.. Только новый массив, если таковой должен будет быть?..


Цитата:

Задача №1

Код:
Private Sub Form_Load()

'поиск первых 27 членов требуемой последовательности
Call fun1(27)

End Sub

Sub fun1(ByVal n As Integer)
'Напечатать первые n натуральных чисел, которве при удалении последней
'цифры уменьшаются в челое число раз. Вывести на экран эти числа с
'указанием во сколько раз они уменьшаются.
Dim i As Integer, k As Integer

If n < 1 Then

MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"
Exit Sub

End If

'первое проверяемое число -- 10, по вполне понятным причинам
'но можно начинать и с i=1, только при этом придётся изменить
'цикл while следующим образом:
'
' Do While k < n
'
' If i >= 10 Then
'
' If (i Mod (i \ 10)) = 0 Then
'
' k = k + 1
' MsgBox i & " (уменьшается во столько раз: " & (i \ (i \ 10)) & ")", _
' vbOKOnly + vbInformation, k & "-й член последовательности"
'
' End If
'
' End If
'
' i = i + 1
'
' Loop
'
i = 10
k = 0

Do While k < n

If (i Mod (i \ 10)) = 0 Then

k = k + 1
MsgBox i & " (уменьшается во столько раз: " & (i \ (i \ 10)) & ")", _
vbOKOnly + vbInformation, k & "-й член последовательности"

End If

i = i + 1

Loop

End Sub

Legio, Спасибо))

Насчет второй..не очень поняла вопрос...но в листбокс выволится массив, который получился)) Я ответила?)))

Дорогой Legio, спасибо тебе, за решение задачки, она действует! Но в универе её не оценили. Короче сказали сделать попроще- без массивов и чтобы эти натуральные числа можно было вводить. Я честно билась над этим 2 ночи (к тебе опять неудобно было обращаться). Но ничего не получилось. И поэтому я, такая бессовестная личность, молю тебя о помощи! ray

lapulechka
А без массивов скучно... =__=

(Соответственно, чтобы оно работало на форме должны быть три TextBox'а -- называющиеся Text1, Text2 и Text3; и CommandButton -- Command1)

Код: Option Explicit

Private Sub Command1_Click()
Dim tRes As Integer

'если в текстовых полях введены числа, вычисляется НОК
'в противном случае выводится сообщение об ошибке
If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) And IsNumeric(Text3.Text) Then

'контроля ввода нет:
'если в текстовое поле будет введено не натуральное число,
'оно будет окрулено до целого (вроде бы )
tRes = srcNOK(Text1.Text, Text2.Text, Text3.Text)

'если НОК не равен нулю, результат вычисления выводится на экран
If tRes > 0 Then MsgBox "НОК данных чисел равно " & tRes

Else

MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"

End If

End Sub

Private Sub Form_Load()

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""

End Sub

Function srcNOK(ByVal a As Integer, ByVal b As Integer, ByVal c As Integer) As Currency
Dim i As Integer, tRes As Currency

'если любое из заданных чисел окажется меньше единицы
'выдаётся сообщение об ошибке и возвращается
If a < 1 Or b < 1 Or c < 1 Then

MsgBox "Wrong values", vbOKOnly + vbCritical, "Warning"
srcNOK = 0
Exit Function

End If

i = 2

tRes = 1

'пока хоть одно из чисел больше, чем i, продолжается поиск множителей
Do While (i <= a) Or (i <= b) Or (i <= c)

'если хоть одно число делится на i без остатка
'значит это
If ((a Mod i) * (b Mod i) * (c Mod i)) = 0 Then

'тогда программа пытается каждое из чисел разделить на i
If a Mod i = 0 Then a = a \ i
If b Mod i = 0 Then b = b \ i
If c Mod i = 0 Then c = c \ i

'потом умножает промежуточный результат на переменную i
tRes = tRes * i

'и сбрасывает значение переменной i в значение 2
i = 2

Else

'в противном случае проверяется следующее значение переменной i (увеличенное на 1)
i = i + 1

End If

Loop

'окончательный результат возвращается
srcNOK = tRes

End Function

привет,помогите написать програму!!!
совсем горю!
Нужно определить функцию,устанавливающую вид взаимного расположения двух прямых на плоскости.
препод сказал,что выглядит примерно это так:
у=k1x1+b1
y2=k2x2+b2

Legio, Ты просто мой Спаситель! Мне вообще это назавтра надо, я сёдня все книги перерыла, кое-что получилось, но кое-что и глючило. А теперь с твоей помощью я завтра всё успешно сдам!

Если без массива то примерно так


Option Explicit
Private Sub Form_Load()
Dim a As Integer, b As Integer, c As Integer, i As Integer, s As Currency
'инициализация переменных... Задаём 3 натуральных числа
a = 7
b = 17
c = 34
For s = 1 To a * b * c
If (s Mod a = 0) And (s Mod b = 0) And (s Mod c = 0) Then
MsgBox s: Exit For
End If
Next s
End Sub

только работает медленней и при очень больших числах переполнение

Добавлено:
KRIVIZNA
а какой результат должна возвращать функция? пересекаются ли? под каким углом? в какой точке?

AndronH

Цитата:

только работает медленней и при очень больших числах переполнение

Не должно быть переполнения. Currency ажно в несколько десятков раз перекрывает Integer в кубе.

Я тут ещё содной штучкой зависла:    Обработка числовой последовательности с заданным количеством элементов.В числовую переменную последовательно вводятся N натуральных k-значных чисел. Найти сумму цифр каждого числа последовательности.

Я решила так:
Private Sub Command1_Click()
Dim N As Integer, i As Integer
Dim a As Single
Dim c As Single

Dim P As String, K As String
Text1.Text = "": Text2.Text = ""
P = InputBox("Сколько чисел?", "Количество чисел")
N = Val(P)
a = 0
For i = 1 To N
K = InputBox("Введите" + Str(i) + "число и нажмите кнопку <OK>", "Ввод очередного числа")
Text1.Text = Text1.Text + K + Chr(13) + Chr(10)
a = a + Val(K)
Next i
c = Val(Text1.Text)
tisach = c \ 1000
sotni = (c - tisach * 1000) \ 100
des = (c - (tisach * 1000 + sotni * 100)) \ 10
ed = c Mod 10
a = tisach + sotni + des + ed
Text2.Text = a
End Sub


Тока вот последовательность не получается, знаю только, что Лист Бокс применить надо и Rnd . Что я только с ними не делала!

lapulechka

Цитата:

знаю только, что Лист Бокс применить надо и Rnd . Что я только с ними не делала!

Назачем?


Цитата:

Тока вот последовательность не получается

Собственно сумма цифр натурального числа на ура считается как-нибудь вот так:

Код: Function countSum(ByVal tN As Long) As Integer
Dim i As Integer, tRes As Integer

If tN < 0 Then tN = -tN

tRes = 0

Do While (tN \ 10) > 0

tRes = tRes + tN Mod 10
tN = tN \ 10

Loop

tRes = tRes + tN

countSum = tRes

End Function

Просто вся помощь препода заключилась в том , что он дал пример наподобие которого сделать надо свой вариант:

Private Sub Image4_Click()
Dim i%, j%, n%, k%, f As Boolean
If Option2.Value Then
Text1 = "": Text2 = ""
Label1 = "Среди всех 4-значных натуральных чисел найти общее " & _
"количество простых и значение наибольшего из них."
Label5 = "Макс. простой:": Label6 = "Кол-во простых:"
Label7 = "Простые числа:"
Label7.Visible = True
List1.Visible = True: List1.Clear
k = 0
For i = 1000 To 9999
f = True
For j = 2 To i \ 2
If i Mod j = 0 Then f = False: Exit For
Next j
If f Then n = i: k = k + 1: List1.AddItem Str(n)
Next i
Text1 = Str(n): Text2 = Str(k)
End If
End Sub
Private Sub Option2_Click()
Image4.Picture = Image1.Picture
End Sub


Вот я и пытаюсь подогнать под свою.

А вот на этод код, ошибка выдаётся

Цитата:

Function countSum(ByVal tN As Long) As Integer
Dim i As Integer, tRes As Integer

If tN < 0 Then tN = -tN

tRes = 0

Do While (tN \ 10) > 0

tRes = tRes + tN Mod 10
tN = tN \ 10

Loop

tRes = tRes + tN

countSum = tRes

End Function

И где в нём вообще i участвует?

lapulechka

Цитата:

И где в нём вообще i участвует?

А нигде не участвует. Забыл убрать


Цитата:

А вот на этод код, ошибка выдаётся

Ошибка может выдаваться только в одном случае -- если в функцию передать текст
(update: или если передать в неё число, вылезающее за границы типа Long... но это уже вопрос не к функции, а тому, кто её использует )

Господа, вроде разобрался с блитингом, возник вопроспо чтению данных из файла...
В файле данные в таком формате
1:1:0:0:20993:Ukrainian:32729:31749;1:1:0:0:2243:Zim:32807:31848;1:1:0:0:5546:Nikkiya:32774:31819;1:0:0:0:8648:SC1:32829:31826;
определяем по порядку числа. (до каждого двоеточия, конец строки;)
1 - изучена система или нет.
2 - есть маяк или нет.
3 - упускаем
4 - упускаем
5 - Номер звезды
6 - Имя планеты
7 и 8 координаты x и у.
От пункта 1 и 2 зависит какая картинка будет выводиться. Номер звезды должен выводиться под рисунком.
Собственно вопрос - как правильно считать информацию из данного файла и как дальше работать с переменными. Так как в дальнейшем просто будет обработка того, что юзер нажимает на рисунке и у него открывается характеристики планеты.
Словом несовсем пойму как лучше сделать......
Помогите плиз. Если можно с примером.

А чего бы и не через split()?

Legio
Если мона, покажи небольшой пример. Я просто не могу въехать.... Да, количество таких данных в файле изначально неизвестно. Их может быть и 10000....

DLysenko

Цитата:

Да, количество таких данных в файле изначально неизвестно. Их может быть и 10000....

A variable-length string can contain up to approximately 2 billion (2^31) characters. ^__^

dim tZzz() as String
tZzz = split(tString,";")

в результате в tZzz будет массив строк вида:

"1:1:0:0:20993:Ukrainian:32729:31749"
"1:1:0:0:2243:Zim:32807:31848"
"1:1:0:0:5546:Nikkiya:32774:31819"
"1:0:0:0:8648:SC1:32829:31826"
+-последняя пустая строка

с которыми потом можно обходиться схожим образом.
Но должны, думаю, быть и более разумные способы.

Добрый день, мальчики!

Один мой знакомый помог зарегистрироваться на вашем форуме, сказал, что только здесь мне смогут оказать помощь. Я получаю образование юриста, мне это всегда нравилось, естественные науки мне легко даются, вся беда в том, что среди основных предметов есть информатика... вначале было все понятно, но у нас поменялся преподаватель и теперь нас заставляет выполнить контрольную работу для сдачи экзамена. Он так и сказал: «Мне не важно сможете ли вы объяснить сделанное, контрольная должна быть сделана»… Если не трудно, помогите пожалуйста! Со своей стороны обещаю оказать посильную помощь в правовых вопросах.

1. Прямая на плоскости задается уравнением ax+by+c=0, где a и b одновременно не равны нулю. Пусть F – файл, содержащий коэффициенты нескольких прямых. Найти все точки пересечения этих прямых. Результат поместить в другой файл.
2. Дан замкнутый многоугольник координатами своих вершин (выпуклость многоугольника необязательна). Найти окружность минимального диаметра, описанную вокруг этого многоугольника.
3. Дано действительное число А, многочлен Р(х) степени n. Получить многочлен P(x)*(А*х+В). Коэффициенты многочленов сохранять в динамических списках.
4. «Исправление ошибок». Пусть по некоторому каналу связи передается сообщение, имеющее вид последовательности нулей и единиц (или точек и тире). Из-за помех возможен ошибоч-ный прием некоторых сигналов: нуль может быть воспринят как единица и наоборот. Для повышения надежности передачи сообщений применяют мажорирование, когда каждый сигнал троируется (например 101 преобразуется в 111000111). При расшифровке три последовательные цифры заменяются той цифрой, которая среди этой тройки встречается по крайней мере дважды. Написать программу шифровки и расшифровки мажорированных сообщений.
5. Указать маршрут коня, начинающийся на заданном поле шахматной доски и заканчивающийся на другом. Никакое поле не должно встречаться в маршруте дважды. Найти самый короткий маршрут.

Legio
Тогда последний вопрос, как сделать что бы переменные выбирались по типу например:
переменная а до первого знака :
Просто резать весь массив...хм, незнаю... я предполагаю время займет немеренно.
Я смотрел то что ты предложил, мысль родилась такая что из одного массива сделать несколько. И соответственно просто каждой переменной в каждом массиве будут соответствовать определенные данные.

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

Но должны же быть и какие-нибудь разумные способы

KMelolika
1.
[more]
'=== Создать класс с именем LineClass ===

Код:
Public A As Double
Public B As Double
Public C As Double
Public NextItem As LineClass

AndVGri, большое вам спасибо!
Честно говоря, абсолютно не понимаю что все это значит, но попробую передать ваше решение своему знакомому, может он что-то с этим сможет сделать. Даже то, что вы сделали для меня неоценимо, поскольку, я в этом вообще ничего не понимаю. Касательно вашего вопроса... к сожалению, задание нам выдали на листиках, где ничего кроме самого задания больше нет, т.е. я все задачи перепечатала дословно.

KMelolika
Со 2-ым заданием я, похоже, несколько упростил до радиуса как половины максимального расстояния между точками. требуется корректировка. Надо обмозговать.
Вот 4 задание. С 3 неинтересно возиться. Может и на 3 балла хватит и этого
[more]
'Функция кодирования текста в массив байтов, по условию 3-го дублирования
Public Function CodeMajor(ByVal thisText As String) As Byte()
Dim vResult() As Byte, vLength As Long
Dim i As Long, vCode As Byte

vLength = 3& * Len(thisText) 'определим требуемый размер массива
ReDim vResult(0& To vLength - 1&)

For i = 0& To vLength - 1& Step 3& 'заполнение кодами
'получить код символа и продублировать трижды
vCode = CByte(Asc(Mid$(thisText, i \ 3& + 1&, 1&)))
vResult(i) = vCode: vResult(i + 1&) = vCode: vResult(i + 2&) = vCode
Next i
CodeMajor = vResult
End Function
'Функция декодирования массива, по условию 3-го дублирования, в текст
Public Function DecodeMajor(ByRef thisArray() As Byte) As String
Dim vFirst As Long, vLast As Long
Dim sResult As String, i As Long
'определим границы массива
vFirst = LBound(thisArray)
vLast = UBound(thisArray)
'проверим на требование кратности 3 и выдадим сообщение об ошибке
If ((vLast - vFirst + 1&) Mod 3&) <> 0& Then
MsgBox "Число элемнетов массива не кратно 3", vbCritical, "Ошибка"
Err.Raise 13
End If

For i = vFirst To vLast Step 3&
If (thisArray(i) = thisArray(i + 1&)) Or (thisArray(i) = thisArray(i + 2&)) Then
sResult = sResult & Chr$(CLng(thisArray(i)))
ElseIf thisArray(i + 1&) = thisArray(i + 2&) Then
sResult = sResult & Chr$(CLng(thisArray(i + 1&)))
Else
sResult = sResult & "_" 'если не равных пар - заменяем на "_"
End If
Next i
DecodeMajor = sResult
End Function
[/more]

AndVGri, доброй ночи! Еще раз огромное вам спасибо! По поводу оценки ничего сказать не могу, у нового преподавателя никто еще не сдавал... буду надеяться, что не я одна такая. Конечно, когда он (преподаватель) давал установку на контрольную, он ясно дал понять, что контрольная должна быть сделана, а вот в каком объеме...

KMelolika
Вот исправил 2 задание. А то получился частный случай
[more]
'=== Необходимо создать класс PointClass ===
Public X As Double
Public Y As Double
Public NextItem As PointClass
'=== End Class ===

'==== Код для вычисления радиуса (основная процедура CalcRadius) ===
'процедура чтения файла координат точек многоугольника
Private Sub ReadPoints(ByVal FileName As String, ByRef toRoot As PointClass)
Dim vX As Double, vY As Double, Item As PointClass
Dim fNum As Integer

fNum = FreeFile()
Open FileName For Input As #fNum
Do Until EOF(fNum)
Set Item = New PointClass
Input #fNum, vX, vY
Item.X = vX: Item.Y = vY
Set Item.NextItem = toRoot
Set toRoot = Item
Loop
Close #fNum
End Sub

'Функция нахождения минимального радиуса круга для многоугольника
Private Function GetRadius(ByVal Point1 As PointClass, ByVal Point2 As PointClass, _
ByVal inRoot As PointClass, ByVal startRadius As Double) As Double
Dim Item As PointClass, Dist As Double, Xc As Double, Yc As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim r1 As Double, r2 As Double, P As Double

'координаты центра окружности через 2 точки
Xc = 0.5 * (Point1.X + Point2.X): Yc = 0.5 * (Point1.Y + Point2.Y)
'по списку координат точек
Set Item = inRoot
Do Until Item Is Nothing
'если точка в списке не пара исходных
If Not ((Point1 Is Item) Or (Point2 Is Item)) Then
'выислить расстояние от центра окружности до точки
'и проверить на превышение радиуса окружности
Dist = Math.Sqr((Xc - Item.X) ^ 2 + (Yc - Item.Y) ^ 2)
If Dist > startRadius Then
'вычислить радиус и координаты центра окружности по 3 точкам
A = Point1.X - Item.X: B = Point1.Y - Item.Y
C = Point2.X - Item.X: D = Point2.Y - Item.Y
r1 = 0.5 * (A ^ 2 + B ^ 2): r2 = 0.5 * (C ^ 2 + D ^ 2)
P = 1# / (A * D - B * C)
Xc = (D * r1 - B * r2) * P: Yc = (A * r2 - C * r1) * P
startRadius = Math.Sqr(Xc * Xc + Yc * Yc)
Xc = Xc + Item.X: Yc = Yc + Item.Y
End If
End If
Set Item = Item.NextItem
Loop
GetRadius = startRadius
End Function
'Основная процедура нахождения минимального радиуса круга для многоугольника
Private Sub CalcRadius(ByVal InputFile As String)
Dim pRoot As PointClass, vMax As Double, Dist As Double
Dim pCurrentPoint As PointClass, pNextPoint As PointClass
Dim pMaxPoint1 As PointClass, pMaxPoint2 As PointClass

'Читаем координаты точек многоугольника
Call ReadPoints(InputFile, pRoot)
'Для каждой точки многоугольника
Set pCurrentPoint = pRoot
Do Until pCurrentPoint Is Nothing
'Ищем расстояние до последующих в списке
'и определяем максимальное расстояние между 2 точками
Set pNextPoint = pCurrentPoint.NextItem
Do Until pNextPoint Is Nothing
Dist = Math.Sqr((pNextPoint.X - pCurrentPoint.X) ^ 2 + (pCurrentPoint.Y - pNextPoint.Y) ^ 2)
If vMax < Dist Then
vMax = Dist
'сохраняем ссылки на точки, расстояние между которыми максимально
'через них окружность пройдёт всегда
Set pMaxPoint1 = pCurrentPoint
Set pMaxPoint2 = pNextPoint
End If
Set pNextPoint = pNextPoint.NextItem
Loop
Set pCurrentPoint = pCurrentPoint.NextItem
Loop
'вычисляем минимальный радиус
vMax = GetRadius(pMaxPoint1, pMaxPoint2, pRoot, 0.5 * vMax)
MsgBox "Минимальный радиус описанной окружности: " & CStr(vMax), vbInformation, "Ответ"
End Sub
[/more]

И, до кучи, 3 задание
[more]
'=== Нужно создать класс PolynomItem ===
Public Coefficient As Double
Public Power As Integer
Public NextItem As PolynomItem
'=== End Class ===

'=== Код функции умножения полинома ===
Public Function MultPolynom(ByVal Polynom As PolynomItem, ByVal Ax As Double, ByVal B As Double)
Dim Result As PolynomItem, Item As PolynomItem, pNext As PolynomItem
'создаём полином результата
Item = New PolynomItem
'находим Cn*X^n * A * x
Item.Power = Polynom.Power + 1
Item.Coefficient = Ax * Polynom.Coefficient
Set Result = Item 'установим ссылку на результат
'находим Cn*X^n * B
Set Item.NextItem = New PolynomItem
Set Item = Item.NextItem
Item.Coefficient = B * Polynom.Coefficient
Item.Power = Polynom.Power

'циклом для элементов полинома n-1..0
Set pNext = Polynom.NextItem
Do Until pNext Is Nothing
'Если есть в результате степень на 1 большая
'x^3*x - четвёртая степень есть от предыдущего
'умножения X^4 на В, корректируем на подобный член
If (pNext.Power + 1) = Item.Power Then
Item.Coefficient = Item.Coefficient + Ax * pNext.Coefficient
Else 'если нет, то добавляем новый элемент в результат
Set Item.NextItem = New PolynomItem
Set Item = Item.NextItem
Item.Power = pNext.Power + 1
Item.Coefficient = Ax * pNext.Coefficient
End If
'добавляем элемент для B
Set Item.NextItem = New PolynomItem
Set Item = Item.NextItem
Item.Power = pNext.Power
Item.Coefficient = B * pNext.Coefficient
'к следующему элементу полинома
Set pNext = pNext.NextItem
Loop
Set MultPolynom = Result
End Function

[/more]

AndVGri, я просто счастлива!!! Спасибочки!!! Как и обещала, если вам что-то понадобится узнать из области права, буду рада оказать помощь, уж в этом я очень хорошо разбираюсь. Еще раз огромное мерси!

Всем привет! Это опять я, задачку прошлую решила с горем пополам.
А вот с этой пока не справилась:

. Определить количество чисел, введенных за последним простым числом в
последовательности с неопределенным количеством элементов.
Мне предложили сделать так:

№3
код:
Private Sub Команда1_Click()
p = Текст1.Text + " "
For I = 1 To Len(p)
If Mid(p, I, 1) <> " " Then k = k + Mid(p, I, 1): GoTo 1
a = Val(k): f = 0
For j = 2 To a \ 2
If a / j = a \ j Then f = 1: j = a \ 2
Next
If f = 1 Then m = I
k = " "

1: Next
For I = m + 1 To Len(p)
If Mid(p, I, 1) <> " " Then k = k + Mid(p, I, 1): GoTo 2
o = o + 1: k = " "
2: Next
Метка1.Lable = o
End Sub

Метка1 ---в нее будет выдаваться кол-во за последним простым



Но у меня не получается с этим кодом. Тем более , что мне надо Rnd задействовать.
Должно действовать примерно так:
1)Жмешь на кнопку Комманд
2) Появляется Input Box "Закончить ввод" (Да/Нет) С помощью Rnd появляются числа в List (причём числа и простые и сложные)
3) После того как ввод чисел закончишь, в окошке Теxt должно появиться количество чисел введённых за последним простым числом.
Rnd задаём как:
N = Int(Rnd * 1000)

Если у кого появится желание мне помочь, я буду счастлива, т.к. в помощи очень нуждаюсь.

lapulechka
Код который дали - полный ПЭ. If с Goto, а слабо было заменить <> на = и поставить End If по месту метки? Зачем так пошло прерывать цикл, воздействуя на его переменную, чем Exit For не устроил?
Короче, тут набросок
[more]

Код:
Option Explicit
'Программка тестировалась в VBA (нет у меня VB)
'поэтому некоторые методы для LisBox в VB могут несколько отличаться
'Код события UserForm_Initialize формы помещается в обработчик Form_Load
'Создана форма на ней:
'lblAnswer - Label, куда выводится количество чисел после последнего простого
'tbCount - EditBox, куда вводится количество двухзначных чисел в списке ListBox
'lbNumbers - ListBox, список случайных двухзначных чисел
'btFill - CommandButton, кнопка записи случайных чисел в список числом в tbCount
'btFind - CommandButton, кнопка нахождения количества чисел в списке после простого

Private SimpleNums() As Integer
Private SimpleNumCount As Integer

'Метод обработки события щелчка на кнопке с именем btFill
'заполнение ListBox lbNumbers случайными двухзначными числами,
'число которых, задано задано в TextBox tbCount
Private Sub btFill_Click()
On Error GoTo errHandle
Dim vCount As Integer, i As Integer
'Получим и проверим число двухзначных числе в списке
vCount = CInt(tbCount.Text)
If vCount < 1 Then Err.Raise 13
lbNumbers.Clear
'заполним список требуемым числом двухзначных чисел
For i = 1 To vCount
If (i Mod 5) = 0 Then VBA.Randomize
lbNumbers.AddItem CStr(CInt(100! * VBA.Rnd))
Next i
Exit Sub
errHandle:
'если в поле ввода не число или меньше 1, то пошлём...
If Err.Number = 13 Then
MsgBox "В поле ввода количества двузначных чисел в списке необходимо ввести положительное число", vbExclamation, "Ошибка"
tbCount.SetFocus
Else
MsgBox Err.Description, vbCritical, "Ошибка"
End If
End Sub
'Процедура обработки события кнопки с именем btFind
'нахождение количества чисел после последнего простого числа в списке
'ListBox lbNumbers
Private Sub btFind_Click()
Dim i As Integer, k As Integer
Dim vValue As Integer, isSimple As Boolean
'Проверим на наличие чисел в списке
If lbNumbers.ListCount = 0& Then
MsgBox "Список двухзначных числе пуст", vbExclamation, "Ошибка"
Exit Sub
End If
'ищем последнее простое число в списке с его конца
For i = lbNumbers.ListCount To 1 Step -1
vValue = CInt(lbNumbers.List(i - 1))
isSimple = True 'пусть текущее число простое
'цикл проверки на простое число
For k = 0 To SimpleNumCount
'если число делится нацело на любое простое, то сброс флага простого
If (vValue Mod SimpleNums(k)) = 0 Then
isSimple = False
Exit For
'если число больше в 2 раза простого в массиве простых, то выйдем
ElseIf (vValue \ SimpleNums(k)) = 1 Then
Exit For
End If
Next k
'если число в списке простое, то выведем инфо в подпись lblAnswer и выйдем
If isSimple Then
lblAnswer.Caption = "Чисел после последнего простого: " & _
CStr(lbNumbers.ListCount - i)
Exit Sub
End If
Next i
'если добрались до сюда, то простых чисел в списке нет, сообщим
lblAnswer.Caption = "Простых чисел не обнаружено"
End Sub

'Процедура при загрузке формы (в VB вроде как Form_Load)
'создаёт массив простых чисел от 2 до 49 (по заданию, числа в списке <= 100)
Private Sub UserForm_Initialize()
Dim i, k As Integer
Dim isSimple As Boolean

'создаеём массив
ReDim SimpleNums(0& To 24&)
'вычисляем простые числа
SimpleNums(0&) = 2
SimpleNums(1&) = 3
SimpleNumCount = 1
For i = 5 To 49 Step 2 'чётные уже не простые, цикл по нечётным
isSimple = True 'пусть i простое
'цикл проверки на простое
For k = 0 To SimpleNumCount
'если делится без остатка, то сброс флага простого числа
If (i Mod SimpleNums(k)) = 0 Then
isSimple = False
Exit For
'если текущее простое число массива больше половины проверяемого
ElseIf (i \ SimpleNums(k)) = 1 Then
Exit For
End If
Next k
'если простое число, то добавить в массив простых чисел
If isSimple Then
SimpleNumCount = SimpleNumCount + 1
SimpleNums(SimpleNumCount) = i
End If
Next i
ReDim Preserve SimpleNums(0& To SimpleNumCount) 'усечение по количеству
End Sub

AndVGri
да, код, который мне дали оставляет желать лучшего :smirk , я с ним билась как могла - но он тупой до невозможности. А вот твой работает отлично, как мне надо. Правда я тоже сним покапалась, но там в основном были мои глупые косяки. В общем Спасибо тебе, очень помог!

Ребят, я опять со своими задачками.
Задачка такова: Дан массив из N целых чисел. Циклически сдвигая его элементы вправо, поместить первый из максимальных на последнее место.

Я пока создала такую программку:
Private Sub Form_Load()
Label1 = «Размерность»
Label2 = «Массив»
Label1 = «Размерность»
Label1 = «Максимальное число»
End Sub

Private Sub Command1_Click()
Dim a() As Single
Dim i As Integer
Dim n As Integer
Dim K As String
Dim Max As Single, nMax As Integer
Dim ListIndex As Integer
n = Val(txtN.Text)
ReDim a(1 To n)
txtМассив.Text = ""

Randomize Timer
For i = 1 To n
a(i) = Int(101 * Rnd())
txtМассив.Text = txtМассив.Text + "" + Str(a(i))
Next i

For i = 2 To n
If a(i) > Max Then
Max = a(i)
End If
Next i
txtMax.Text = Str(Max)
End Sub


А вот циклически сдвигать никак не получается. И эту фразу вообще не догоняю «первый из максимальных» (как это может быть?) Я на это забила и решила, что максимальный всё-таки один. Помогите PlZ циклически сдвинуть элементы, а то у меня хаотически сдвинутся мозги.