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 |