Задание. Выделить цветом в диапазоне все зависимые строки.
Зависимыми считать строки, если одна строка получается в результате умножения другой строки на коэффициент.
По-другому можно так сказать: зависимые строки получаются тогда, когда одна строка делится на другую, получаются коэффициенты и если эти коэффициенты равны - то строки зависимые.
Другими словами: надо каждую ячейку одной строки делить на каждую ячейку другой строки, для каждой пары ячеек будет свой кэф и затем надо сравнить все кэфы при сравнении двух строк.
В диапазоне могут быть не только числовые, но и текстовые данные, поэтому должны быть две проверки:
1) является ли данное записанное в ячейке - числом или нет, если нет - то обойти ячейку;
2) проверка деления на 0, если число в ячейке делится на 0, обойти ячейку.
Задание надо сделать в модуле-классе. А в обычном модуле (основном) надо создать экземпляр объектов этого модуля-класса.
Вот код макроса для главного модуля, где будут создаваться экземпляры класса-модуля:
Спойлер
Option Explicit
Sub ОбработатьДиапазон()
Dim Диапазон As КлассДиапазон
Set Диапазон = New КлассДиапазон
Set Диапазон.Область = Worksheets("Практическая №2").Range("D7:H12")
Диапазон.Определитькоэффициент (True)
Set Диапазон = Nothing
End Sub
Прилагаю скриншот в качестве вложения.
Как мне все это реализовать? Помогите мне пожалуйста. А то я уже который день не могу придумать оптимальный алгоритм для решения данной задачи.
Посмотрите, работает ли макрос согласно заданию.
Пока модуль-класса я не делал, т.к. сначала нужно сделать просто работающий макрос. Если макрос правильно сделан, то дальше уже будем думать, как его оформить в виде модуля-класса.
Макрос сделан на основе фото из первого сообщения, поэтому вам надо тестировать на листе с такой-же структурой, как на фото в первом сообщении. То есть таблица должна располагаться в D7:H12. Данные в таблице могут быть любые.
Макрос
Sub макрос()
Dim rng As Range, kef As Double
Dim i As Long, ii As Long, j As Long
'1. Присваивание имени "rng" фрагменту, в котором данные.
' Так удобнее будет писать и читать код.
Set rng = Range("D7:H12")
' Цикл от первой строки до предпоследней.
For i = 1 To rng.Rows.Count - 1
'2. Проверка, нет ли в текущей строке нечисел. Если есть,
' то смысла сравнивать строку с другими нет.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(i, j)) = False Then
GoTo metka_NextI
End If
Next j
' Цикл от текущей строки + 1 до последней строки.
For ii = i + 1 To rng.Rows.Count
'3. Проверка, нет ли во второй строке нечисел и нулей.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(ii, j)) = False Then
GoTo metka_NextII
End If
If rng.Cells(ii, j) = 0 Then
GoTo metka_NextII
End If
Next j
'4. Расчёт кэфа для первой пары.
' Такой же кэф должен быть и в остальных парах.
kef = rng.Cells(i, 1).Value / rng.Cells(ii, 1).Value
'5. Расчёт кэфов в остальных парах и сравнение его с кэфом в переменной "kef".
For j = 2 To rng.Columns.Count
' Если текущий кэф другой, то значит строки независимые.
' Остальные пары нет смысла сравнивать.
If rng.Cells(i, j) / rng.Cells(ii, j) <> kef Then
GoTo metka_NextII
End If
Next j
'6. Если макрос дошёл до сюда, значит кэфы у всех пар равны и строки зависимые.
' Закраска строк.
rng.Rows(i).ActiveCell.Interior.Color = 11854022
rng.Rows(ii).ActiveCell.Interior.Color = 11854022
metka_NextII:
Next ii
metka_NextI:
Next i
End Sub
Вы можете без оператора GoTo обойтись в коде? А так код работает и все хорошо, просто преподаватель сказал что нежелательно использовать этот оператор
Вариант без GoTo:
Макрос
Sub макрос()
Dim rng As Range, kef As Double
Dim i As Long, ii As Long, j As Long
'1. Присваивание имени "rng" фрагменту, в котором данные.
' Так удобнее будет писать и читать код.
Set rng = Range("D7:H12")
' Цикл от первой строки до предпоследней.
For i = 1 To rng.Rows.Count - 1
'2. Проверка, нет ли в текущей строке нечисел. Если есть,
' то смысла сравнивать строку с другими нет.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(i, j)) = False Then
Exit For
End If
Next j
' Если были просмотрены все ячейки текущей строки и не было преджевременного выхода из цикла.
If j > rng.Columns.Count Then
' Цикл от текущей строки + 1 до последней строки.
For ii = i + 1 To rng.Rows.Count
'3. Проверка, нет ли во второй строке нечисел и нулей.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(ii, j)) = False Then
Exit For
ElseIf rng.Cells(ii, j) = 0 Then
Exit For
End If
Next j
' Если были просмотрены все ячейки второй строки и не было преджевременного выхода из цикла.
If j > rng.Columns.Count Then
'4. Расчёт кэфа для первой пары.
' Такой же кэф должен быть и в остальных парах.
kef = rng.Cells(i, 1).Value / rng.Cells(ii, 1).Value
'5. Расчёт кэфов в остальных парах и сравнение его с кэфом в переменной "kef".
For j = 2 To rng.Columns.Count
' Если текущий кэф другой, то значит строки независимые.
' Остальные пары нет смысла сравнивать.
If rng.Cells(i, j) / rng.Cells(ii, j) <> kef Then
Exit For
End If
Next j
' Если не было преждевременного выхода из цикла, значит все кэфы равны.
If j > rng.Columns.Count Then
'6. Закраска строк.
rng.Rows(i).ActiveCell.Interior.Color = 11854022
rng.Rows(ii).ActiveCell.Interior.Color = 11854022
End If
End If
Next ii
End If
Next i
End Sub
В модулях-классах ещё используются процедуры-свойства и ещё какие-то. Я такое не делаю, поэтому не смогу помочь. Могу предложить только такой вариант.
Просто в VBA классы не используются, поэтому VBA-программисты не работают с классами. Классы используются в других языках программирования. Просто в VBA нет ситуаций, когда нужно создавать классы, т.к. таких задач не существует.
Чтобы макрос работал, у модуля-класса должно быть имя "ЗависимыеСтроки".
Код для обычного модуля
Sub Макрос()
Dim ЗависимыеСтроки As ЗависимыеСтроки
Set ЗависимыеСтроки = New ЗависимыеСтроки
Set ЗависимыеСтроки.Диапазон = Range("D7:H12")
ЗависимыеСтроки.ЗакраситьЗависимыеСтроки
Set ЗависимыеСтроки = Nothing
End Sub
Код для модуля-класса:
Public Диапазон As Range
Sub ЗакраситьЗависимыеСтроки()
Dim rng As Range, kef As Double
Dim i As Long, ii As Long, j As Long
'1. Присваивание имени "rng" фрагменту, в котором данные.
' Так удобнее будет писать и читать код.
Set rng = Диапазон
' Цикл от первой строки до предпоследней.
For i = 1 To rng.Rows.Count - 1
'2. Проверка, нет ли в текущей строке нечисел. Если есть,
' то смысла сравнивать строку с другими нет.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(i, j)) = False Then
Exit For
End If
Next j
' Если были просмотрены все ячейки текущей строки и не было преджевременного выхода из цикла.
If j > rng.Columns.Count Then
' Цикл от текущей строки + 1 до последней строки.
For ii = i + 1 To rng.Rows.Count
'3. Проверка, нет ли во второй строке нечисел и нулей.
For j = 1 To rng.Columns.Count
If IsNumeric(rng.Cells(ii, j)) = False Then
Exit For
ElseIf rng.Cells(ii, j) = 0 Then
Exit For
End If
Next j
' Если были просмотрены все ячейки второй строки и не было преджевременного выхода из цикла.
If j > rng.Columns.Count Then
'4. Расчёт кэфа для первой пары.
' Такой же кэф должен быть и в остальных парах.
kef = rng.Cells(i, 1).Value / rng.Cells(ii, 1).Value
'5. Расчёт кэфов в остальных парах и сравнение его с кэфом в переменной "kef".
For j = 2 To rng.Columns.Count
' Если текущий кэф другой, то значит строки независимые.
' Остальные пары нет смысла сравнивать.
If rng.Cells(i, j) / rng.Cells(ii, j) <> kef Then
Exit For
End If
Next j
' Если не было преждевременного выхода из цикла, значит все кэфы равны.
If j > rng.Columns.Count Then
'6. Закраска строк.
rng.Rows(i).ActiveCell.Interior.Color = 11854022
rng.Rows(ii).ActiveCell.Interior.Color = 11854022
End If
End If
Next ii
End If
Next i
End Sub