Найти номер последней из строк матрицы, содержащих максимальное количество одинаковых элементов - 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

Оцени полезность:

13   голосов , оценка 4.077 из 5
Похожие ответы