Помощь - Поиск - Пользователи - Календарь
Полная версия: Vba
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Ада и другие языки
Lord of assembly
Код
Option Explicit
Sub êðç1()
Dim a(100) As Integer
Dim i As Integer
Dim N As Integer
Dim K As Integer
Dim R As Integer
For i = 1 To 100
Cells(1, i) = Int(Rnd * 100 - 50)
a(i) = Cells(1, i)
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
End If
Next i
For i = 1 To 100
If a(i) Mod 2 <> 0 Then
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Next i
For K = 1 To 100 - 1
    For i = 1 To 100 - K
        If a(i) < a(i + 1) Then
            R = a(i)  
            a(i) = a(i + 1)
            a(i + 1) = R
        End If
    Next i
Next K
For i = 1 To 100
    Cells(5, i) = a(i)
Next i
If a(i) Mod 5 = 2 Then
a(i) = Cells(7, i)
a(i) = a(i + 1)
For i = 1 To 100
Next i
N = N - 1
End If
End Sub

Помогите пожалуйста проверить код, а задача звучит так
Задан одномерный массив F(N). В данном массиве выполнить:
1. Увеличить все чётные элементы массива в два раза, а нечётные уменьшить на единицу. Полученный массив распечатать.
2. Элементы полученного массива расположить по убыванию. Массив распечатать.
3. Удалить из вновь образованного массива все элементы, кратные пяти. Массив распечатать.
4. Во вновь образованной последовательности вычислить сумму чётных элементов и вставить это значение перед каждым элементом, кратным трем. Значение суммы и вновь образованный массив распечатать.
И если не затруднит подскажите как сделать четвертую часть ну очень надо. Заранее благодарен.
Ozzя
Эту часть короче можно и нужно переписать:
Код
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
ELSE
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Lord of assembly
Оzzя не подскажешь почемму у меня в
Код
Next i
If a(i) Mod 5 = 2 Then
a(i) = Cells(7, i)
a(i) = a(i + 1)
For i = 1 To 100
Next i
N = N - 1
End If

этой части выдает ошибку
Ozzя
Там всё так запутано unsure.gif
Цитата
Удалить из вновь образованного массива все элементы, кратные пяти.

Я бы сделал так:
Код
j=1
For i = 1 To 100
  If a(i) Mod 5 = 0 Then
     b(j)=a(i)
     j=j+1
Next i

Используя вспомогательный массив

Цитата
Во вновь образованной последовательности вычислить сумму чётных элементов и вставить это значение перед каждым элементом, кратным трем.

Цитата

sum=0
For i = 1 To nb
If b(i) Mod 2 = 0 Then
sum=sum+b(j)
Next i


Сейчвс прогоню, только на qb
Ozzя
Сортировка не стал делать. Часть 4-я выползает иногда выход за пределы индекса
Нужно вколотить при проверке на кратность, чтобы чсило не було =0
Код
CONST n = 10

DIM a(n * 2), b(n * 2), c(n * 2) AS INTEGER

RANDOMIZE TIMER
CLS
FOR i = 1 TO n
  a(i) = INT(RND * 100)
NEXT i

FOR i = 1 TO n
  PRINT a(i);
NEXT i
PRINT

FOR i = 1 TO n
  IF a(i) MOD 2 = 0 THEN
    a(i) = a(i) * 2
  ELSE
    a(i) = a(i) - 1
  END IF
NEXT i

FOR i = 1 TO n
  PRINT a(i);
NEXT i
PRINT

j = 1
FOR i = 1 TO n
  IF a(i) MOD 5 <> 0 THEN
    b(j) = a(i)
    j = j + 1
    nb = j
  END IF
NEXT i

FOR i = 1 TO nb
  PRINT b(i);
NEXT i

sum = 0
j = 1
FOR i = 1 TO nb
  IF b(i) MOD 2 = 0 THEN
    sum = sum + b(i)
    j = j + 1
    nc = j
  END IF
NEXT i

PRINT

nc = nc + nb
PRINT nc
REDIM c(nc)
j = 1
FOR i = 1 TO nc
  IF b(i) MOD 3 = 0 THEN
    c(j) = sum
    j = j + 1
  ELSE
    c(j) = b(i)
    j = j + 1
  END IF
NEXT i

PRINT
FOR i = 1 TO nc
  PRINT c(i);
NEXT i
Lord of assembly
Код
Option Explicit
Sub ÊÐÇ1()
Dim a(100) As Integer
Dim i As Integer
Dim N As Integer
Dim K As Integer
Dim R As Integer
For i = 1 To 100
Cells(1, i) = Int(Rnd * 100 - 50)
a(i) = Cells(1, i)
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
Else
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Next i
For K = 1 To 100 - 1
    For i = 1 To 100 - K
        If a(i) < a(i + 1) Then
            R = a(i)
            a(i) = a(i + 1)
            a(i + 1) = R
        End If
    Next i
Next K
For i = 1 To 100
    Cells(5, i) = a(i)
Next i
For i = 1 To 100
If a(i) Mod 5 = 0 Then
a(i) = a(i) - a(i)
Else
Cells(7, i) = a(i)
End If
Next i
End Sub

я так сделал без четвертого
Ozzя
Код
If a(i) Mod 5 = 0 Then
a(i) = a(i) - a(i)

А это зачем? blink.gif
Получается, что если число кратно 5, то из элемента массива вычитаем его самого.
Lord of assembly
Удаление происходит таким обрзом попробуй сам
Ozzя
Да я VBA не знаю. Я в QB делал.
Может, в VBA и так. blink.gif
А вообще,
Код
a(i) = a(i) - a(i)
означает что в a(i) заносится 0.
Lord of assembly
По идее так оно так но из масива удаляется без заменения на нуль
Lord of assembly
Код
Option Explicit
Sub ÊÐÇ1()
Dim a(100) As Integer
Dim i As Integer
Dim N As Integer
Dim K As Integer
Dim R As Integer
Dim sum As Double
For i = 1 To 100
Cells(1, i) = Int(Rnd * 100 - 50)
a(i) = Cells(1, i)
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
Else
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Next i
For K = 1 To 100 - 1
    For i = 1 To 100 - K
        If a(i) < a(i + 1) Then
            R = a(i)
            a(i) = a(i + 1)
            a(i + 1) = R
        End If
    Next i
Next K
For i = 1 To 100
    Cells(5, i) = a(i)
Next i
For i = 1 To 100
If a(i) Mod 5 = 0 Then
a(i) = a(i) - a(i)
Else
Cells(7, i) = a(i)
End If
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
sum = sum + a(i)
End If
Next i
Cells(9, 1) = sum

End Sub

Я сделал часть четвертого и хотел спросить , а можно как - нибудь сделать вставку значения перед каждым элементом без вспомогательного массива
Lord of assembly
Цитата
а можно как - нибудь сделать вставку значения перед каждым элементом без вспомогательного массива

Это я сам понял, но я не могу понять как вставить перед каждым элементом кратным 3 сумму четных элементов mega_chok.gif wacko.gif
Ozzя
Код
sum = 0
j = 1
FOR i = 1 TO nb
  IF b(i) MOD 2 = 0 THEN
    sum = sum + b(i)
    j = j + 1
    nc = j
  END IF
NEXT i


Код
IF b(i) MOD 3 = 0 THEN
    c(j) = sum
Lord of assembly
Извени, но мне надо без вспомогательных массивов
Код
Option Explicit
Sub КРЗ1()
Dim a(100) As Integer
Dim i As Integer
Dim N As Integer
Dim K As Integer
Dim R As Integer
Dim sum As Double
For i = 1 To 100
Cells(1, i) = Int(Rnd * 100 - 50)
a(i) = Cells(1, i)
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
Else
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Next i
For K = 1 To 100 - 1
    For i = 1 To 100 - K
        If a(i) < a(i + 1) Then
            R = a(i)
            a(i) = a(i + 1)
            a(i + 1) = R
        End If
    Next i
Next K
For i = 1 To 100
    Cells(5, i) = a(i)
Next i
For i = 1 To 100
If a(i) Mod 5 = 0 Then
a(i) = a(i) - a(i)
Else
Cells(7, i) = a(i)
End If
Next i
sum = 0
For i = 1 To 100
If a(i) Mod 2 = 0 Then
sum = sum + a(i)
End If
Next i
Cells(9, 1) = "Сумма четных элементов ="
Cells(9, 4) = sum

For i = 1 To 100
If a(i) Mod 3 = 0 And a(i) <> 0 Then
Cells(11, i) = sum + a(i)
End If
Next i

Вставить элемент подскажи как вставить
Lord of assembly
Код
Option Explicit
Sub крз1()
Dim a(100) As Integer
Dim i As Integer
Dim N As Integer
Dim K As Integer
Dim R As Integer
Dim j As Integer
Dim sum As Double
For i = 1 To 100
Cells(1, i) = Int(Rnd * 100 - 50)
a(i) = Cells(1, i)
Next i
For i = 1 To 100
If a(i) Mod 2 = 0 Then
a(i) = a(i) * 2
Cells(3, i) = a(i)
Else
a(i) = a(i) - 1
Cells(3, i) = a(i)
End If
Next i
For K = 1 To 100 - 1
    For i = 1 To 100 - K
        If a(i) < a(i + 1) Then
            R = a(i)
            a(i) = a(i + 1)
            a(i + 1) = R
        End If
    Next i
Next K
For i = 1 To 100
    Cells(5, i) = a(i)
Next i
For i = 1 To 100
If a(i) Mod 5 = 0 Then
a(i) = a(i) - a(i)
Else
Cells(7, i) = a(i)
End If
Next i
sum = 0
For i = 1 To 100
If a(i) Mod 2 = 0 Then
sum = sum + a(i)
End If
Next i
Cells(9, 1) = "Сумма четных элементов ="
Cells(9, 4) = sum
N = 100
i = 1
While i <= N
      If a(i) Mod 3 = 0 And a(i) <> 0 Then
         For j = N + 1 To i + 1 Step -1
             x(j) = x(j - 1)
         Next j
         x(i) = sum
         N = N + 1
         i = i + 2
      Else
         i = i + 1
      End If
Wend
Cells(11, i) = a(i)
End Sub

В чем тут у меня ошибка показывает что
Код
x(j) = x(j - 1)
тут но я не уверен
Может кто-нибудь предложит какой-нибудь другой метод вставки
volvo
Посмотри внимательно на изменения в программе...
Код
Option Explicit
Public Sub test_func()
Dim a(200) As Integer ' именно 200, иначе возможен subscript error в четвертом задании
Dim i As Integer
Dim N As Integer
Dim R As Integer
Dim j As Integer
Dim sum As Double

For i = 1 To 100
  a(i) = Int(Rnd * 100 - 50)
  Cells(1, i) = a(i)
Next i

' #1
For i = 1 To 100
  If a(i) Mod 2 = 0 Then
    a(i) = a(i) * 2
    Cells(3, i) = a(i)
  Else
    a(i) = a(i) - 1
    Cells(3, i) = a(i)
  End If
Next i


' #2
For i = 1 To 100
  For j = 100 To i + 1 Step -1
    If a(j - 1) < a(j) Then
      R = a(j - 1)
      a(j - 1) = a(j)
      a(j) = R
    End If
  Next j
Next i

' Print array #2
For i = 1 To 100
  Cells(5, i) = a(i)
Next i


' #3
N = 100
i = 1
While i <= N
  If a(i) Mod 5 = 0 Then
    For j = i To N - 1
      a(j) = a(j + 1)
    Next j
    N = N - 1
  End If
  i = i + 1
Wend

' Print array #3
For i = 1 To N
  Cells(7, i) = a(i)
Next i


'#4
sum = 0
For i = 1 To 100
  If a(i) Mod 2 = 0 Then
    sum = sum + a(i)
  End If
Next i

Cells(9, 1) = "even elements sum = "
Cells(9, 4) = sum

i = 1
While i <= N

  If a(i) Mod 3 = 0 And a(i) <> 0 Then
    For j = N - 1 To i Step -1
      a(j + 1) = a(j)
    Next j
    a(i) = sum
    
    N = N + 1
    i = i + 1
  End If
  i = i + 1
Wend

' Print array #4
For i = 1 To N
  Cells(11, i) = a(i)
Next i
End Sub
Lord of assembly
Большое спасибо.
Lord of assembly
Код
Option Explicit
Sub Rhp1()
Dim a(5, 5) As Integer
Dim i As Integer, j As Integer
Dim s As Double, k As Double
Dim min As Integer, max As Integer
Dim ih As Integer, imax As Integer
For i = 1 To 5
For j = 1 To 5
a(i, j) = Cells(i, j)
Next j
Next i
s = 0: k = 0: max = 12
For i = 1 To 5
For j = 1 To 5
If a(i, j) Mod 2 <> 0 Then s = s + a(i, j) Else k = k + 1
If a(i, j) > max Then
max = a(i, j)
imax = i
ih = Cells(i, 1) + Cells(1, 2)
End If
Next j
Next i
Cells(7, 6) = ("Сумма нечетных элементов = " & s)
Cells(8, 6) = ("Количество четных элементов = " & k)
Cells(9, 6) = ("Максимумы  - " & imax)
Cells(10, 6) = ("Произведение элементов в первой четверти = " & ih)
End Sub

Помогите пожалуйста проверить ещё один код
Вот задание
1.Сформировать матрицу вида

1 2 2 2 2
3 1 2 2 2
3 3 1 2 2
3 3 3 1 2
3 3 3 3 1

2.Вычислить в этой матрице сумму нечетных элементов.
3.Вычислить количество четных элементов в каждой строке матрицы.
4.Вычислить максимумы в нечетных столбцах.
5.Вычислить произведение элементов в первой четверти.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.