Basic

[Anutka]

Помогите пожалуйста, позарез необходимо прграмму написать :lol: :

1) Дан одномерный массив F1,F2...Fn. Все отрицательные элементы заменить их абсолютным значением. Найти среднее арифметическое тех элементов массива с четными номерами, значения которых находятся в интервале [C,D]. Найти сумму квадратов номеров минимального и первого нулевого элементов массива.

Заранее спасибо всем тем, кто откликнется!!!!!!

 

[faizeleze]

Помогите пожалуйста, позарез необходимо прграмму написать :

1) Дан одномерный массив F1,F2...Fn. Все отрицательные элементы заменить их абсолютным значением. Найти среднее арифметическое тех элементов массива с четными номерами, значения которых находятся в интервале [C,D]. Найти сумму квадратов номеров минимального и первого нулевого элементов массива.

Заранее спасибо всем тем, кто откликнется!!!!!!

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

Const n = 1000
Const C = -5
Const D = 30
Const RndRange = 100
Dim MyArray(n)

Sub Main()
Call Initialize
Cells(1, 4) = SumMinNull
Call DeleteNegative
Cells(1, 3) = AvgArray
End Sub

Function SumMinNull()
MinCount = 1
MinValue = MyArray(1)
NullCount = 0
For i = 2 To n
If (MyArray(i) = 0 And NullCount = 0) Then NullCount = i
If MyArray(i) < MinValue Then
MinCount = i
MinValue = MyArray(i)
End If
Next
If NullCount > 0 Then Cells(NullCount, 1).Font.Bold = True Else MsgBox ("Нуля в массиве нет!")
Cells(MinCount, 1).Font.Bold = True
SumMinNull = NullCount ^ 2 + MinCount ^ 2
End Function

Function AvgArray()
SumEnd = 0
SumCount = 2
SumArray = 0
Do
If (C < D And MyArray(SumCount) >= C And MyArray(SumCount) <= D) Or (D <= C And MyArray(SumCount) >= D And MyArray(SumCount) <= C) Then
SumArray = SumArray + MyArray(SumCount)
SumEnd = SumEnd + 1
End If
SumCount = SumCount + 2
Loop Until SumCount >= n
AvgArray = SumArray / SumEnd
End Function

Public Sub DeleteNegative()
For i = 1 To n
If MyArray(i) < 0 Then MyArray(i) = Abs(MyArray(i))
Cells(i, 2) = MyArray(i)
Next
End Sub

Public Sub Initialize()
For i = 1 To n
Randomize
MyArray(i) = Int(RndRange / 2 - Rnd * RndRange)
Cells(i, 1) = MyArray(i)
Next
Range("A:A").Font.Bold = False
End Sub

 

[faizeleze]

Кстати если делать без процедур в одном цикле, то примерно так это все выглядит:

Const n = 1000
Const C = -5
Const D = 30
Const RndRange = 100
Dim MyArray(n)
MinCount = 1
NullCount = 0
SumEnd = 0
SumArray = 0
Range("A:A").Font.Bold = False
For i = 1 To n
Randomize
MyArray(i) = Int(RndRange / 2 - Rnd * RndRange)
Cells(i, 1) = MyArray(i)
If MinValue = Null Then MinValue = MyArray(i)
If (MyArray(i) = 0 And NullCount = 0) Then NullCount = i
If MyArray(i) < MinValue Then
MinCount = i
MinValue = MyArray(i)
End If
If MyArray(i) < 0 Then MyArray(i) = Abs(MyArray(i))
Cells(i, 2) = MyArray(i)
If (i / 2 = Int(i / 2)) And ((C < D And MyArray(i) >= C And MyArray(i) <= D) Or (D <= C And MyArray(i) >= D And MyArray(i) <= C)) Then
SumArray = SumArray + MyArray(i)
SumEnd = SumEnd + 1
End If
Next
If NullCount > 0 Then Cells(NullCount, 1).Font.Bold = True Else MsgBox ("Нуля в массиве нет!")
Cells(MinCount, 1).Font.Bold = True
Cells(1, 3) = SumArray / SumEnd
Cells(1, 4) = NullCount ^ 2 + MinCount ^ 2