Файлы и математические расчёты функции

Доброго времени суток. Сегодня мы разберём достаточно сложную задачу, которая охватывает несколько пройденных с вами тем ( Работа с файлами и Работа с математическими функциями)

Сама задача состоит в том, чтобы написать программу, которая производит необходимый расчёт функции по данным, введёнными пользователем, и записывает результаты в файл со штампом в начале файла ( » Функция : y = e ^ x, количество точек по х и у и т.д. «). Следует учесть возможность ввести несколько интервалов расчётов.

Также программа должна выводить отчёт о своей работе в файл Output.dat, где должна быть указанна функция, с которой производились операции, количество интервалов введённых пользователем и имена файлов, которые содержат расчёты по тому или иному интервалу. В программе должна быть учтена возможность возникновения ошибки при расчётах и вывод этих ошибок в файл отчёта Output.dat.

Функция от двух переменных в формате G(x, y)=y*F(x), F(x) = где lg(x–5). В случае у принять начальное значение 5, шаг = 0,5 и количество точек 10.

Страшно? Можно сказать, что это уже реальная и практическая задача, которую вам могут дать.
Разбор полётов будет совершаться малыми блоками и не по порядку ( как в исходнике). Это необходимо для наилучшего понимания. Сам исходник, как и раньше, прилагается в конце статьи.
Начнём с того, откуда будем брать данные. Я предлагаю такой формат:

Где x1 — начало интервала, x2 — конец и n — количество точек.

Dim x1() As Double
Dim x2() As Double
Dim nx() As Double
Dim count As Integer
Dim i As Integer
'_________________________________считывание
count = 1
i = 1
Do While count <> 0
    If Cells(i + 1, 1) <> "" Then
        ReDim Preserve x1(i) As Double
        ReDim Preserve x2(i) As Double
        ReDim Preserve nx(i) As Double
        x1(i - 1) = Cells(i + 1, 1)
        x2(i - 1) = Cells(i + 1, 2)
        nx(i - 1) = Cells(i + 1, 3) 
        i = i + 1
    Else: count = 0
    End If
Loop

Пока не попадётся пустая ячейка, мы будем считывать данные и записывать их в соответствующие массивы. Напомню, что Redim Preserve … изменяет размер массива без потери данных внутри него.

'_________________________________расчёт по y
Dim n As Integer
Dim YN As Integer
YN = 10
Dim y() As Double
ReDim y(YN) As Double
Dim hy As Double
n = 5
hy = 0.5
Dim j As Integer
y(0) = n
For j = 1 To YN - 1
    y(j) = y(j - 1) + hy
Next j

Тут несложные действия по расчёту массива y.

ChDir ("C:......\vba\files")
Dim fil As Integer
Dim files() As String
ReDim files(i - 1) As String
For fil = 1 To i - 1
    files(fil - 1) = "G" + CStr(fil) + ".dat"
Next fil

ChDir() — изменят ваше текущее положение в каталогах. По умолчанию вы находитесь там, где открыт файл Excel. В данный момент это необходимо только для удобства, приятнее держать расчётные таблицы отдельно. Не так ли?

Также тут создаём строковый массив, который будет хранить в себе названия расчётных файлов. Переменная i была посчитана в раннее описанном блоке.

Dim stroka_y As String
For j = 0 To 10
    If j = 0 Then
    stroka_y = stroka_y + "x\y" + "     "
    Else: stroka_y = stroka_y + CStr(y(j - 1)) + "         "
    End If
Next j

В данном блоке записывается первая строчка для таблиц. Она везде будет одинаковой. В итоге выглядит она так.

Перед основным блоком напишем математические функции.

Dim erorka As String

Function f(x As Double)
f = Log(x - 5)
End Function
Function G(x As Double, y As Double) As Variant
On Error GoTo errHandler
G = y * f(x)

Exit Function
errHandler:
  MsgBox Err.Description, vbCritical, "Error No: " & Err.Number
G = "NaN"
erorka = erorka + "Ошибка №" + CStr(Err.Number) + "  при x = " + CStr(x) + "  и при у = " + CStr(y) + vbNewLine
Resume Next
End Function

Переменная erorka объявлена глобально, то есть вне всяких процедур и функций (sub и Function). В неё записываются ошибки, возникающие в функции G(). Также при возникновении ошибки, к G приравнивается «NaN». Это возможно, благодаря типу функции as Variant, который может работает как со строками, так и с числами.

При нежелании использовать Variant, советую приравнять G самому минимально возможному в вашем типе числу, а далее сделать отлов этого числа условием и соответствующий вывод в файл.

Теперь главное блюдо:

Dim n_x1 As Double
Dim n_x2 As Double
Dim step As Double
Dim t1 As Integer
Dim t2 As Integer
Dim t3 As Integer
Dim stroka As String
Dim temp As Variant
stroka = ""
For t1 = 1 To i - 1 ' количество интервалов
    n_x1 = x1(t1 - 1)
    n_x2 = x2(t1 - 1)
    step = (n_x2 - n_x1) / nx(t1 - 1)
    Open files(t1 - 1) For Output As #t1
    Print #t1, CStr(nx(t1 - 1)) + " " + CStr(YN) + "  Function: y*lg(x-5)" ' начальная строка файла
    Print #t1, stroka_y ' первая строка таблицы
    For t2 = 1 To nx(t1 - 1) ' количество точек по Х
        stroka = CStr(Round(n_x1, 3)) + "         " ' запись строки для таблицы
        For t3 = 0 To YN - 1 ' количество точек по Y
            temp = G(n_x1, y(t3))
            Cells(2 + t2 + (t1 - 1) * 5, 7 + t3) = temp ' вывод на лист в  excel для проверки
            If t3 <> YN - 1 Then
                If temp <> "NaN" Then
                stroka = stroka + CStr(Round(temp, 3)) + "      "
                Else: stroka = stroka + temp + "      "
                End If
            Else:
                If G(n_x1, y(t3)) <> "NaN" Then
                    stroka = stroka + CStr(Round(temp, 3))
                    Else: stroka = stroka + temp
                End If
          End If
        Next t3
        n_x1 = n_x1 + step
        Print #t1, stroka
    Next t2
    Close #t1
Next t1

Здесь присутствует три цикла: с помощью первого мы проходим по всем интервалам, второго — записываем начальные значения X для таблицы (первый столбец) и третий — уже для записи в строку полученных значений в строку.

Этой командой Open files(t1 — 1) For Output As #t1 мы открываем файл с именем, взятым из массива files и назначаем ему идентификатор #t1. Строка If t3 <> YN — 1 Then проверяет на последний индекс в массиве Y, чтобы корректнее заполнить таблицу. Напомню,что команда Round () округляет значения до указанного количества чисел после запятой.
И последнее, отчёт:

'__________________________________Output.dat

Open "Output.dat" For Output As #1
Print #1, "Name:Example by CodeTown.ru Version:0000000001 beta"
Print #1, "Function: y*lg(x-5)"
Print #1, CStr(i - 1)
For fil = 1 To i - 1
    Print #1, files(fil - 1)
Next fil
Print #1, erorka
Close #1

Выглядеть он будет так:

Сразу скажу, что ошибка допущена специально, для проверки работы обработчика ошибок.
Общий итог ( показано 2 открытых файла расчётов и папка где они лежат ):

На этом мы закончим, молодцы! Если остались вопросы, пишите в комментариях.

Вот исходники, не забудьте прописать путь каталогу в Chdir() или вовсе его стереть.
Скачать исходники