xellga
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Помогите написать к программе пояснения:
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(R) < 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
|
?
