| Код |
Option Explicit
Public Sub Начать_Работу_Щелчок()
Dim istrock As Integer
Dim istolb As Integer
Do
vstrock = InputBox("Ведите количество строк. Желательно не должно превышать 20.", "Ввод начальных данных.")
If IsNumeric(vstrock & "") Then Exit Do
Loop
Do
vstolb = InputBox("Ведите количество столбцов. Желательно не должно превышать 20.", "Ввод начальных данных.")
If IsNumeric(vstolb & "") Then Exit Do
Loop
Dim sstroka As String
sstroka = Str(vstrock) & " x" & Str(vstolb)
Range("B3").Select
ActiveCell.FormulaR1C1 = "Размер матрицы = "
Range("D3").Select
ActiveCell.Value = sstroka
Range("B5").Select
Range("B3:D3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B5").Select
Range("B3:D3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("B6:D6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599963377788629
.PatternTintAndShade = 0
End With
Range("B6").Select
ActiveCell.FormulaR1C1 = "Заполните пожалуйста матрицу"
Range("E6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599963377788629
.PatternTintAndShade = 0
End With
Range("B8").Select
'------------'''
Cells(8, 2).Resize(vstrock, vstolb).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("B8").Select
Range("G6:M6").Select
ActiveCell.FormulaR1C1 = _
"После того, как вы ввели матрицу нажмите кнопку ""Посчитать Ранг!""."
Range("G6:M6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Range("B8").Select
Cells(8, 2).Resize(vstrock, vstolb).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween, Formula1:="-10000", Formula2:="10000"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Введите число!"
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Selection.Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween, Formula1:="-10000", Formula2:="10000"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Введите число!"
.ErrorTitle = "Нужно ввести число!"
.InputMessage = "Действительное!"
.ErrorMessage = _
"Введите число которое не вылазит за рамки допустимо возможного диапазона."
.ShowInput = True
.ShowError = True
End With
Range("B8").Select
End Sub
Option Explicit
Sub Очистить_всё_Щелчок()
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B3").Select
ActiveCell.FormulaR1C1 = ""
Range("D3").Select
ActiveCell.FormulaR1C1 = ""
Range("B6:D6").Select
ActiveCell.FormulaR1C1 = ""
Range("B8:G9").Select
Range("B9").Activate
Selection.ClearContents
Range("B10:H14").Select
Selection.ClearContents
Range("B2").Select
Range("G6:M6").Select
Selection.ClearContents
Range("B2").Select
Cells.Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ErrorTitle = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("B2").Select
Range("L1:Q6").Select
Selection.ClearContents
Range("A1:P27").Select
Selection.ClearContents
Range("B2").Select
End Sub
Option Explicit
Option Base 1
Public Sub CommandButton1_Click()
Dim j As Integer
Dim sz As Integer
Dim l As Integer
Dim k As Integer
Dim n As Integer
Dim min As Integer
Dim mass()
Dim rang As Integer
Dim oRAnge As Range
Set oRAnge = Cells(8, 2).Resize(vstrock, vstolb)
mass = oRAnge
If vstrock < vstolb Then min = vstrock Else min = vstolb
For k = 1 To min
For l = 1 To vstrock
If k <> l Then
If mass(k, k) <> 0 Then
sz = mass(l, k) / mass(k, k)
For j = 1 To vstolb
mass(l, j) = mass(l, j) - sz * mass(k, j)
Next j
End If
End If
Next l
Next k
rang = 0
For l = 1 To min
If mass(l, l) <> 0 Then rang = rang + 1
Next l
Range("M2").Select
ActiveCell.FormulaR1C1 = " Ранг матрицы = "
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("M2:O2").Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "обычный"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("O2").Select
ActiveCell.FormulaR1C1 = Str(rang)
Range("B2").Select
If rang = min Then
Range("M3").Select
ActiveCell.FormulaR1C1 = "Линейная зависимость отсутствует!"
Range("M3:P3").Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "обычный"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("b2").Select
Else
Range("m3").Select
ActiveCell.FormulaR1C1 = "Линейная зависимость присутствует."
Range("M3:Q3").Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "обычный"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End Sub
|
Ето весь код для подтверждения моей работы. Вот цикл | Код |
Dim k As Integer
Dim n As Integer
Dim min As Integer
Dim mass()
Dim rang As Integer
Dim oRAnge As Range
Set oRAnge = Cells(8, 2).Resize(vstrock, vstolb)
mass = oRAnge
If vstrock < vstolb Then min = vstrock Else min = vstolb
For k = 1 To min
For l = 1 To vstrock
If k <> l Then
If mass(k, k) <> 0 Then
sz = mass(l, k) / mass(k, k)
For j = 1 To vstolb
mass(l, j) = mass(l, j) - sz * mass(k, j)
Next j
End If
End If
Next l
Next k
rang = 0
For l = 1 To min
If mass(l, l) <> 0 Then rang = rang + 1
Next l
|
В общем цикл рабочий и правильно всё считает если нету в матрице нулей, когда куча нулей и особенно на главной диагонали то начинается билеберда. Прошу помочь доработать цикл. Напомню, что он вычисляет ранг матрицы размерами n x m. Крестьянские советы через минора прошу не говорить. Добавлено через 4 минуты и 20 секундДля примера, матрица 0 1 1 1 0 1 1 1 1 |
Ранг матрицы, Нужна помощь доделать цикл, а с ним и .. 
Загрузка ...
