Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Решение уравнении методом гауса - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Решение уравнении методом гауса (Макросы/Sub)
Решение уравнении методом гауса
han Дата: Суббота, 07.11.2015, 21:30 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Помогите!!!Работает,но выдаёт не правильный ответ.
И к слову это прога по методу решения системы линейных уравнений методом Гаусса.
[vba]
Код
Sub metodgaussa()
Dim a() As Integer, b() As Integer, x() As Single
n = InputBox("Введите размерность:")
ReDim a(1 To n, 1 To n) As Integer
ReDim b(1 To n) As Integer
ReDim x(1 To n) As Single

For i = 1 To n
For j = 1 To n
s = "Введите элемент матрицы" & " a[" & i & "," & j & "]"
a(i, j) = InputBox(s)

If i = j Then
Do While a(i, i) = 0
s = "Введите не нулевое значение элемента матрицы" & " a[" & i & "," & i & "]"
a(i, i) = InputBox(s)
Loop
End If
Cells(i, j) = a(i, j)
Next j

s1 = "Введите правую часть уравнения" & " b[" & i & "]"
b(i) = InputBox(s1)
Cells(i, n + 2) = b(i)
Next i

For k = 1 To n
For i = k + 1 To n
r = a(i, k) / a(k, k)
For j = k To n
a(i, j) = a(i, j) - r * a(k, j)
Next j
b(i) = b(i) - r * b(k)
Next i
Next k

For k = n To 1 Step -1
r = 0
For j = k + 1 To n
g = a(k, j) * x(j)
r = r + g
Next j
x(k) = (b(k) - r) / a(k, k)
Next k
MsgBox ("Корни системы получены!")

For i = 1 To n
Cells(i, 10) = x(i)
Next i
End Sub
[/vba]
[moder]Оформляйте коды тегами (кнопка #)
На первый раз поправила сама.[/moder]


Сообщение отредактировал Manyasha - Суббота, 07.11.2015, 21:35
 
Ответить
СообщениеПомогите!!!Работает,но выдаёт не правильный ответ.
И к слову это прога по методу решения системы линейных уравнений методом Гаусса.
[vba]
Код
Sub metodgaussa()
Dim a() As Integer, b() As Integer, x() As Single
n = InputBox("Введите размерность:")
ReDim a(1 To n, 1 To n) As Integer
ReDim b(1 To n) As Integer
ReDim x(1 To n) As Single

For i = 1 To n
For j = 1 To n
s = "Введите элемент матрицы" & " a[" & i & "," & j & "]"
a(i, j) = InputBox(s)

If i = j Then
Do While a(i, i) = 0
s = "Введите не нулевое значение элемента матрицы" & " a[" & i & "," & i & "]"
a(i, i) = InputBox(s)
Loop
End If
Cells(i, j) = a(i, j)
Next j

s1 = "Введите правую часть уравнения" & " b[" & i & "]"
b(i) = InputBox(s1)
Cells(i, n + 2) = b(i)
Next i

For k = 1 To n
For i = k + 1 To n
r = a(i, k) / a(k, k)
For j = k To n
a(i, j) = a(i, j) - r * a(k, j)
Next j
b(i) = b(i) - r * b(k)
Next i
Next k

For k = n To 1 Step -1
r = 0
For j = k + 1 To n
g = a(k, j) * x(j)
r = r + g
Next j
x(k) = (b(k) - r) / a(k, k)
Next k
MsgBox ("Корни системы получены!")

For i = 1 To n
Cells(i, 10) = x(i)
Next i
End Sub
[/vba]
[moder]Оформляйте коды тегами (кнопка #)
На первый раз поправила сама.[/moder]

Автор - han
Дата добавления - 07.11.2015 в 21:30
Manyasha Дата: Воскресенье, 08.11.2015, 02:46 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
han, поменяйте тип матрицы a и массива b c integer на double (второй раз необязательно указывать)
[vba]
Код
    Dim a() As Double, b() As Double, x() As Double
    n = InputBox("Введите размерность:")
    ReDim a(1 To n, 1 To n) ' As Double
    ReDim b(1 To n) ' As Double
    ReDim x(1 To n) ' As Double
[/vba]

Проверила 2 раза, с вычислениями на листочке сошлось :)

Кстати, Ваш код не проверяет, имеет ли СЛАУ единственное решение или нет (может их вообще нет), так и должно быть?
И еще, почему нельзя вводить 0?


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеhan, поменяйте тип матрицы a и массива b c integer на double (второй раз необязательно указывать)
[vba]
Код
    Dim a() As Double, b() As Double, x() As Double
    n = InputBox("Введите размерность:")
    ReDim a(1 To n, 1 To n) ' As Double
    ReDim b(1 To n) ' As Double
    ReDim x(1 To n) ' As Double
[/vba]

Проверила 2 раза, с вычислениями на листочке сошлось :)

Кстати, Ваш код не проверяет, имеет ли СЛАУ единственное решение или нет (может их вообще нет), так и должно быть?
И еще, почему нельзя вводить 0?

Автор - Manyasha
Дата добавления - 08.11.2015 в 02:46
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Решение уравнении методом гауса (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!