Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
#1

Перевести функцию из фортрана в VBA

27.05.2012, 13:51. Просмотров 1019. Ответов 12
Метки нет (Все метки)

Нужно сделать функцию из фортрана в vba (с языком абсолютно не знаком, поэтому прошу помощи)

Fortran
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Subroutine KGAUSS(Ab, N, X, IAI) 
Real(8) Ab(N,N+1), X(N) ! Описание массивов 
IAI=1 
Do k=1, N ! <==> For k=1 To N ! Перебор строк - шаги прямого хода 
Call CMEHA ! Выбор и анализ гл. элемента 
If( IAI == 0 ) Return ! <==> Exit Sub ! Выход, если гл. элемент = 0 
Do i=k+1, N ! Перебор строк с k+1-ой по N-ую 
Ab(i,k) = Ab(i,k)/Ab(k,k) 
Ab(i,k+1:N+1) = Ab(i,k+1:N+1) - Ab(i,k)*Ab(k,k+1:N+1) 
End Do 
End Do ! <==> Next k 
Do k = N, 1,-1 ! Обратная подстановка (обратный ход) 
X(k)=Ab(k,N+1)/Ab(k,k) 
Ab(1:N-1,N+1) = Ab(1:N-1,N+1) - Ab(1:N-1,k)*X(k) 
End Do 
Contains ! -------Внутренние подпрограммы: ----------------------------------------
Subroutine CMEHA ! Процедура выбора гл. элемента и перестановки строк 
Real(8) W(N+1) ; Integer L(1) ! Описание массивов 
L=MaxLoc(abs(Ab(K:N,K))) ! Опр. номера строки с гл. элементом 
W=Ab(K,:); Ab(K,:)=Ab(L(1)+K-1,:); Ab(L(1)+K-1,:)=W ! Перестановки 
If(abs(Ab(K,K) )== 0D0) IAI=0 ! IAI - признак вырожденности системы 
End Subroutine 
End
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.05.2012, 13:51
Ответы с готовыми решениями:

VBA Составить функцию VBA
помогите пожалуйста...

Прошу перевести в VBA
Program Насадки; uses crt; var...

Перевести из Pascal в VBA
Перевести uses crt; var n,k,s,p,m,i:longint; begin clrscr; repeat...

Перевести код из С++ в VBA
#include&lt;iostream&gt; using namespace std; void main() { cout&lt;&lt;&quot;Это строки...

Перевести код с Pascal на VBA
Var x: Shortint; BEGIN Writeln('Введите (-1),(0) или (1): '); Readln(x); If...

12
Казанский
14047 / 5777 / 1503
Регистрация: 24.09.2011
Сообщений: 9,054
27.05.2012, 16:02 #2
Примерно так, перестановку не доделал - убегать надо
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub KGAUSS(Ab() As Double, N, X() As Double, IAI)
'Real(8) Ab(N,N+1), X(N) ! Описание массивов
Dim j As Long 'переменная для реализации неявного цикла "Ab(i,k+1:N+1)"
Dim mx As Double, L As Long
IAI = 1
For k = 1 To N ' Перебор строк - шаги прямого хода
    GoSub CMEHA ' Выбор и анализ гл. элемента
    If IAI = 0 Then Exit Sub ' Выход, если гл. элемент = 0
    For i = k + 1 To N ' Перебор строк с k+1-ой по N-ую
        Ab(i, k) = Ab(i, k) / Ab(k, k)
        For j = k + 1 To N + 1
            Ab(i, j) = Ab(i, j) - Ab(i, k) * Ab(k, j)
        Next
    Next
Next 'k
For k = N To 1 Step -1 ' Обратная подстановка (обратный ход)
    X(k) = Ab(k, N + 1) / Ab(k, k)
    For j = 1 To N - 1
        Ab(j, N + 1) = Ab(j, N + 1) - Ab(j, k) * X(k)
    Next
Next
Exit Sub
 
CMEHA: ' Процедура выбора гл. элемента и перестановки строк
'Real(8) W(N+1) ; Integer L(1) ! Описание массивов
'L=MaxLoc(abs(Ab(K:N,K))) ! Опр. номера строки с гл. элементом
mx = 0
L = 0
For j = k To N
    If Abs(Ab(j, k)) > mx Then L = j: mx = Ab(j, k)
Next
'W=Ab(K,:); Ab(K,:)=Ab(L(1)+K-1,:); Ab(L(1)+K-1,:)=W ! Перестановки
'==недоделано: надо реализовать перестановку
 
If Ab(k, k) = 0# Then IAI = 0 ' IAI - признак вырожденности системы
Return
End Sub
1
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
30.05.2012, 01:14  [ТС] #3
не получается у меня ничего с этим vba. Помогите доделать то, что осталось - могу объяснить всё на фортране.
0
Dragokas
Эксперт WindowsАвтор FAQ
16966 / 7051 / 856
Регистрация: 25.12.2011
Сообщений: 10,861
Записей в блоге: 16
30.05.2012, 02:05 #4
Цитата Сообщение от cazs Посмотреть сообщение
могу объяснить всё на фортране.
объясните не на фортране недопереведенное место.
0
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
30.05.2012, 06:11  [ТС] #5
Цитата Сообщение от Diskretor Посмотреть сообщение
объясните не на фортране недопереведенное место.
не на фортране не могу, знаком только с ним
0
ikki
призрак
2823 / 879 / 118
Регистрация: 11.05.2012
Сообщений: 1,702
Записей в блоге: 2
30.05.2012, 08:33 #6
cazs, что ДЕЛАЕТ этот код?
я правильно понимаю, что это решение СЛАУ методом Гаусса?
и, если да - то Вам нужен именно "перевод", максимально приближенный к "оригиналу", или устроит любая реализация этого метода?

Добавлено через 7 минут
пс. с фортраном вообще не знаком, вникать в синтаксис ради этой одной задачи... мягко говоря, смысла не вижу, имхо, проще написать заново код, решающий задачу.
вот только какую задачу?

ппс. предположение (заметьте - я никуда Вас не посылаю!) - скорее всего, в сети дофигища примеров реализаций гаусса на всяких разных языках (включая древнегреческий ассемблер).
0
Dragokas
Эксперт WindowsАвтор FAQ
16966 / 7051 / 856
Регистрация: 25.12.2011
Сообщений: 10,861
Записей в блоге: 16
30.05.2012, 14:27 #7
Цитата Сообщение от cazs Посмотреть сообщение
объясните не на фортране недопереведенное место.
не на фортране не могу, знаком только с ним

Не по теме:

Ну, не на фортране есть еще русский язык ;), хотя
ikki_cf, похоже, опередил.

0
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
30.05.2012, 14:29  [ТС] #8
Цитата Сообщение от ikki_cf Посмотреть сообщение
cazs, что ДЕЛАЕТ этот код?
я правильно понимаю, что это решение СЛАУ методом Гаусса?
и, если да - то Вам нужен именно "перевод", максимально приближенный к "оригиналу", или устроит любая реализация этого метода? [/COLOR].
Да это решение СЛАУ методом Гаусса.

Цитата Сообщение от ikki_cf Посмотреть сообщение
Добавлено через 7 минут
пс. с фортраном вообще не знаком, вникать в синтаксис ради этой одной задачи... мягко говоря, смысла не вижу, имхо, проще написать заново код, решающий задачу.
вот только какую задачу? [/COLOR].
У меня другая проблема - с фортраном знаком, а с VBA ни разу не общался.

Цитата Сообщение от ikki_cf Посмотреть сообщение
ппс. предположение (заметьте - я никуда Вас не посылаю!) - скорее всего, в сети дофигища примеров реализаций гаусса на всяких разных языках (включая древнегреческий ассемблер).
Находил только одно решение, вот оно

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit
    Dim a(3, 4) As Double, i As Integer, j As Integer, k As Single
 
Private Sub Command1_Click()
    a(1, 1) = 1: a(1, 2) = 3: a(1, 3) = -1: a(1, 4) = 4
    a(2, 1) = -1: a(2, 2) = 2: a(2, 3) = 3: a(2, 4) = 12
    a(3, 1) = 2: a(3, 2) = 1: a(3, 3) = -1: a(3, 4) = 1
    
    myPrint
    
    k = (a(3, 1) / a(1, 1))
    For i = 1 To 4
        a(3, i) = a(3, i) - k * a(1, i)
    Next
    k = (a(2, 1) / a(1, 1))
    For i = 1 To 4
        a(2, i) = a(2, i) - k * a(1, i)
    Next
    k = (a(3, 2) / a(2, 2))
    For i = 1 To 4
        a(3, i) = a(3, i) - k * a(2, i)
    Next
    a(3, 4) = a(3, 4) / a(3, 3)
    a(3, 3) = 1
    
    k = (a(2, 3) / a(3, 3))
    For i = 1 To 4
        a(2, i) = a(2, i) - k * a(3, i)
    Next
    a(2, 4) = a(2, 4) / a(2, 2)
    a(2, 2) = 1
    
    k = (a(1, 3) / a(3, 3))
    For i = 1 To 4
        a(1, i) = a(1, i) - k * a(3, i)
    Next
    k = (a(1, 2) / a(2, 2))
    For i = 1 To 4
        a(1, i) = a(1, i) - k * a(2, i)
    Next
    a(1, 4) = a(1, 4) / a(1, 1)
    a(1, 1) = 1
 
    myPrint
    
End Sub
 
Sub myPrint()
    Print CStr(a(1, 1)) + vbTab + CStr(a(1, 2)) + vbTab + CStr(a(1, 3)) + vbTab + CStr(a(1, 4))
    Print CStr(a(2, 1)) + vbTab + CStr(a(2, 2)) + vbTab + CStr(a(2, 3)) + vbTab + CStr(a(2, 4))
    Print CStr(a(3, 1)) + vbTab + CStr(a(3, 2)) + vbTab + CStr(a(3, 3)) + vbTab + CStr(a(3, 4))
    Print vbCrLf
End Sub
Но оно, если мягко выразиться "ни о чем", вообще не понял в чем тут суть дела у них.
0
ikki
призрак
2823 / 879 / 118
Регистрация: 11.05.2012
Сообщений: 1,702
Записей в блоге: 2
30.05.2012, 14:50 #9
Цитата Сообщение от cazs Посмотреть сообщение
Находил только одно решение, вот оно
какой-то... странный у Вас интернет...

по немудреному запросу "VBA метод гаусса" бог Йандекс нашёл 25тыс. страниц.
конечно, не все из них подходят, но вот это было на первой странице результатов:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Dim m(100, 100), m1(100), Raz, k 
 
 Private Sub Form_Load() 
   Raz = InputBox("") 
   Randomize 
   For y = 1 To 100 
     For x = 1 To 100 
       m(x, y) = Fix(Rnd * 10) 
     Next x 
     m1(y) = Fix(Rnd * 10) 
   Next y 
   Prt 
   For i = 1 To Raz - 1 
     For y = i + 1 To Raz 
       k = -m(i, y) / m(i, i) 
       For x = i To Raz 
         m(x, y) = m(x, y) + m(x, i) * k 
       Next x 
       m1(y) = m1(y) + m1(i) * k 
     Next y 
   Next i 
   For y = 1 To Raz 
     For i = 1 To y - 1 
       m1(Raz + 1 - y) = m1(Raz + 1 - y) - m1(Raz + 1 - i) * m(Raz + 1 - i, Raz + 1 - y) 
     Next i 
     m1(Raz + 1 - y) = m1(Raz + 1 - y) / m(Raz + 1 - y, Raz + 1 - y) 
   Next y 
   Prt1 
 End Sub 
 
 Sub Prt() 
   Print k 
   For y = 1 To Raz 
     tmp = "" 
     For x = 1 To Raz 
       tmp = tmp & m(x, y) & " " 
     Next x 
     tmp = tmp & " " & m1(y) & " " 
     Print tmp 
   Next y 
   Print 
 End Sub 
 
 Sub Prt1() 
   Print 
   For y = 1 To Raz 
     Print "x" & y & " = " & m1(y) 
   Next y 
   Print 
 End Sub
не проверял.
хотя, на мой взгляд, подозрительно длинноватый код
но там и ещё есть.
1
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
30.05.2012, 16:30  [ТС] #10
Может код не рабочий, а может я не понял как он работает, но ругается на
Visual Basic
1
 Print
. Я плохой знаток VBA, но разве в нём есть функция принт?
0
Dragokas
Эксперт WindowsАвтор FAQ
16966 / 7051 / 856
Регистрация: 25.12.2011
Сообщений: 10,861
Записей в блоге: 16
30.05.2012, 16:34 #11
Нету. Попробуйте дописать перед каждой debug.
Visual Basic
1
Debug.Print
1
cazs
0 / 0 / 0
Регистрация: 27.05.2012
Сообщений: 8
01.06.2012, 00:51  [ТС] #12
Благодарю, проблема решилась. Но тут задаётся само уравнение через инпут бокс и рандомайз, а надо чтобы задавалось со страницы EXCEL, так как будет использоваться не со случайными цифрами, а с цифрами заданными со страниц.

Добавлено через 53 минуты
Актуально, как вписать в эту функцию задание со страницы, а не через рандомайз?
0
Dragokas
Эксперт WindowsАвтор FAQ
16966 / 7051 / 856
Регистрация: 25.12.2011
Сообщений: 10,861
Записей в блоге: 16
01.06.2012, 07:45 #13
Задавать формулу с листа не ахти. Это ж не MathCAD. Были здесь специфические темы.
Задать данные в массив M с листа №1, и в m1 с листа № 2 можно, например, так:
Visual Basic
1
2
3
Dim M,m1
m = range(sheets(1).[A1],sheets(1).cells(100,100))
m1=application.transpose(range(sheets(2).[a1:a100])
0
01.06.2012, 07:45
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
01.06.2012, 07:45

Можно ли перевести программу с VB на VBA?
Здравствуйте скажите можно ли перевести программу с VB на VBA? и если да то...

Перевести код из Pascal в VBA
Собственно вот надо чтобы работало в вба : Приложение 1 Листинг программы:...

Перевести программу с Паскаля на VBA
const N=9; var i: integer; Max: integer; A: array of integer; B:...


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

Или воспользуйтесь поиском по форуму:
13
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru