Найти номер последней из строк матрицы, содержащих максимальное количество одинаковых элементов - VBA
Формулировка задачи:
Дана целочисленная матрица размера M × N. Найти номер последней из ее строк, содержащих максимальное количество одинаковых элементов.
Просидел пол ночи, туплю жестко, ребят что не так?
--
---
Объясните пожалуйста!
Решение задачи: «Найти номер последней из строк матрицы, содержащих максимальное количество одинаковых элементов»
textual
Листинг программы
Sub Макрос1() Макрос2 Dim r As Long, c As Long, k As Long, rn As Range r = Cells(1, 3) c = Cells(1, 6) k = Cells(3, 3) Range(Cells(9, 1), Cells(r + 8, c)).Select For Each rn In Selection rn = Int(Rnd * Selection.count / r / 2) Next rn Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .Weight = xlThin End With 'MsgBox "1<=k<=n", 64, "" Cells(9, 1).Select End Sub Sub Макрос2() r = Cells(1, 3) c = Cells(1, 6) Range(Cells(9, 1), Cells(r + 8, c + 3)).ClearContents End Sub Sub magic() r = Cells(1, 3) c = Cells(1, 6) k = Cells(3, 3) Dim rt As Range, r1 As Range, Nmax As Long, Rmax As Long Set rt = Range(Cells(9, 1), Cells(r + 8, c)) For rr = 1 To r For cc = 1 To c If WorksheetFunction.CountIf(rt.Rows(rr), rt(rr, cc)) > rt(rr, 1).Offset(, c + 1) Then rt(rr, 1).Offset(, c + 1) = WorksheetFunction.CountIf(rt.Rows(rr), rt(rr, cc)) End If Next cc If rt(rr, 1).Offset(, c + 1) >= Nmax Then Nmax = rt(rr, 1).Offset(, c + 1): Rmax = rr Next rr rt.Rows(Rmax).Select MsgBox Rmax End Sub