Vba

Тема в разделе "Visual Basic", создана пользователем xellga, 8 фев 2009.

  1. xellga

    xellga Гость

    Помогите пожалуйста, написать пояснения к программе:
    Public Sub AddMenu()
    Dim comBar As CommandBar
    Dim comBarBut As CommandBarButton
    Dim mnuXXX As CommandBarControl
    Dim N As Long
    Dim ii As Long
    Set comBar = CommandBars("WorkSheet Menu Bar")
    N = comBar.Controls.Count
    For ii = 1 To N
    If comBar.Controls(ii).Caption = "Matrix" Then Exit Sub
    Next ii
    Set mnuXXX = comBar.Controls.Add(Type:=msoControlPopup, Temporary:=True, Before:=N)
    With mnuXXX
    .Caption = "Matrix"
    With .Controls.Add(Type:=msoControlButton)
    .Caption = "Generate"
    .OnAction = "Main"
    End With
    With .Controls.Add(Type:=msoControlButton)
    .Caption = "Clear"
    .OnAction = "Clear"
    End With
    End With
    End Sub

    Public Sub DelMenu()
    Dim comBar As CommandBar
    Dim comBarBut As CommandBarButton
    Dim N As Long
    Dim ii As Long
    Set comBar = CommandBars("WorkSheet Menu Bar")
    N = comBar.Controls.Count
    For ii = 1 To N
    If comBar.Controls(ii).Caption = "Matrix" Then
    comBar.Controls(ii).Delete
    Exit For
    End If
    Next ii
    End Sub
    ---------------------------------
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Const Epsilon As Double = 0.01
    Private Const ShowMult As Boolean = True

    Private Matrix() As Double
    Private tmpMatrix() As Double
    Private N As Long
    Private NewTMatrix() As Double
    Private TMatrix() As Double

    Private Pi As Double
    Private Row As Long

    Public Sub Main()
    Dim I As Long
    Dim J As Long
    Dim L As Long
    Dim Amax As Double
    Dim p As Double
    Dim CosFi As Double
    Dim SinFi As Double
    Dim IMax As Long
    Dim JMax As Long
    Dim Iter As Long
    Dim pIMax As Long
    Dim pJMax As Long
    Dim Tii As Double
    Dim Tij As Double
    Dim Tji As Double
    Dim Tjj As Double
    Clear
    Randomize (Time)
    Pi = Atn(1)
    N = CLng(InputBox("Введите размерность матрицы." + Chr(10) + "(меньше 20)", "GenerateMatrix", 5))
    If N = 0 Then
    Row = 2
    MyGenerate
    Row = Row + N + 1
    Else
    ReDim Matrix(1 To N, 1 To N) As Double
    ReDim tmpMatrix(1 To N, 1 To N) As Double
    ReDim TMatrix(1 To N, 1 To N) As Double
    'ReDim NewTMatrix(1 To N, 1 To N) As Double
    Row = 2
    'формируем матрицу
    For I = 1 To N
    For J = 1 To N
    Matrix(I, J) = Rnd(1) * 20
    Next J
    Next I
    End If
    Show Row
    ActiveSheet.Range("C" + CStr(Row)).FormulaR1C1 = "Исходная матрица"
    For I = 1 To N
    For J = 1 To N
    If (I = J) Or (J = I + 1) Or (J = I - 1) Then Matrix(I, J) = Matrix(I, J) Else Matrix(I, J) = 0
    Next J
    Next I
    Row = Row + N + 3
    Show Row
    ActiveSheet.Range("C" + CStr(Row)).FormulaR1C1 = "Трехлинейная матрица"
    For I = 1 To N
    For J = 1 To N - 1
    L = Abs(Matrix(I, J + 1) - Matrix(I, J))
    If L = 0 Then L = 1
    X = Matrix(I, J)

    Do While (X <= (Matrix(I, J) + Abs(Matrix(I, J + 1) - Matrix(I, J))))
    X = X + Epsilon
    tmpMatrix(I, J) = ((1 - X) / L) * Matrix(I, J) + (X / L) * Matrix(I, J + 1)
    tmpMatrix(I, J) = X
    Loop
    Next J
    Next I

    For I = 1 To N
    For J = 1 To N
    TMatrix(I, 1) = TMatrix(I, 1) + tmpMatrix(I, J)
    Next J
    Next I
    Row = Row + N + 3
    For R = 1 To N
    C = 1
    ActiveSheet.Cells(R + Row, C + 1).Value = TMatrix(R, C)
    Next R
    End Sub

    Public Sub MultMatrix(FirstMatr() As Double, _
    SecondMatr() As Double, _
    ResMatrix() As Double)
    Dim I As Long
    Dim J As Long
    Dim K As Long
    Dim R As Double
    ReDim ResMatrix(1 To N, 1 To N) As Double
    'Умножаем матрицу на другую матрицу...
    For J = 1 To N
    For I = 1 To N
    R = 0
    For K = 1 To N
    R = R + FirstMatr(I, K) * SecondMatr(K, J) ', K)
    Next K
    If Abs&reg; < Epsilon Then R = 0
    ResMatrix(I, J) = R
    Next I
    Next J
    End Sub

    Public Sub Transp(InputMatrix() As Double)
    Dim I As Long
    Dim J As Long
    For I = 1 To N
    For J = I + 1 To N
    Swap InputMatrix(I, J), InputMatrix(J, I)
    Next J
    Next I
    End Sub

    Public Sub Swap(A As Double, B As Double)
    Dim C As Double
    C = A
    A = B
    B = C
    End Sub

    Public Function Sp() As Double
    Dim I As Long
    Dim Tmp As Double
    Tmp = 0
    For I = 1 To N
    Tmp = Tmp + Matrix(I, I)
    Next I
    Sp = Tmp
    End Function


    Private Sub Show(Row As Long)
    Dim R As Long
    Dim C As Long
    For R = 1 To N
    For C = 1 To N
    ActiveSheet.Cells(R + Row, C + 1).Value = Matrix(R, C)
    Next C
    Next R
    End Sub

    Public Sub Clear()
    ActiveSheet.Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Selection.NumberFormat = "0.0000"
    Selection.ColumnWidth = 9
    End Sub

    Private Sub MyGenerate()
    Dim I As Long
    Dim J As Long
    Dim Angle As Double
    Dim CosFi As Double
    Dim SinFi As Double
    Dim IMax As Long
    Dim JMax As Long
    N = 10
    ReDim Matrix(1 To N, 1 To N) As Double
    ReDim tmpMatrix(1 To N, 1 To N) As Double
    ReDim TMatrix(1 To N, 1 To N) As Double
    ReDim NewTMatrix(1 To N, 1 To N) As Double
    For I = 1 To N
    For J = 1 To N
    If I = J Then
    Matrix(I, J) = CLng(Rnd(1) * 20)
    Else
    Matrix(I, J) = 0
    End If
    Next J
    Next I
    Show Row
    For IMax = 1 To N
    For JMax = IMax + 1 To N
    For I = 1 To N
    For J = 1 To N
    If I = J Then
    TMatrix(I, J) = 1
    Else
    TMatrix(I, J) = 0
    End If
    Next J
    Next I

    Angle = Rnd(1) * 360
    Angle = Angle * 2 * Pi / 360
    CosFi = Cos(Angle)
    SinFi = Sin(Angle)
    TMatrix(IMax, IMax) = CosFi
    TMatrix(IMax, JMax) = SinFi
    TMatrix(JMax, IMax) = -SinFi
    TMatrix(JMax, JMax) = CosFi
    MultMatrix TMatrix, Matrix, tmpMatrix
    Transp TMatrix
    MultMatrix tmpMatrix, TMatrix, Matrix
    Next JMax
    Next IMax
    End Sub
     
Загрузка...

Поделиться этой страницей