Dim v() As Variant
For Each MyRow In Range("checked").Rows
x = MyRow.Row
If j = 0 Then
ReDim v(1 To 4, 0)
Else
ReDim Preserve v(1 To 4, UBound(v, 2) + 1)
End If
v(1, j) = MyRow.Cells(3).Value & MyRow.Cells(4).Value & MyRow.Cells(9).Value & MyRow.Cells(10).Value
v(2, j) = x 'номер строки
v(3, j) = MyRow.Cells(30).Value 'КТТ
v(4, j) = ""
j = j + 1
Next MyRow
Затем хочу пройтись по всем значениям v(1):
Код
Dim Kttmax%
For j = 0 To UBound(v(1))
...
Next j
и получаю ошибку "Subscript out of rangeКак правильно пройтись по ним?
Надо было сразу прикладывать файл с неупрощенной действительностью. Сейчас получается, что весь мой предыдущий труд был сделан впустую. А возвращаться к этой задаче я не хочу, да и некогда.
- это ведь читали... Да и зачем вообще таким способом работать с массивом? Есть несколько других простых способов, но т.к. задача неизвестна, то и способы озвучивать смысла нет...
borro, не вникал, но гляньте тут. Я собираю всё в одномерный, а потом по алгоритму в цикле "пилю" на блоки в другие размерности…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Nordheim написал: Приложите файл пример небольшой. а то не понятно, что и как у вас работает.
Вот пример полотна, по которому должен формироваться массив v(). Если описать всю задачу, то она такова( возможно это вопрос другой темы, простите модераторы) Я проверяю заполненность значений этой большой таблицы. Для того чтобы пометить красным какое-то неправильное значение в этой таблице мне предварительно надо всю ее просканировать и получить объект данных, который бы по номеру строки листа(в пределах таблицы), отвечающую за отдельное устройство, говорил, это устройство на "вводе" или нет. Что значит, что устройство на "вводе": На предварительном проходе выбрать из таблицы следующие данные(как я выше пытаюсь в массив v()): 1. Номер строки на листе 2. Ключ привязки к топологии сети - это сцепленные значения столбцов 4,5,10,11 3. Коэффициент из столбца 31 4. Пустой столбец для последующей простановки признака ввод/не ввод 5. Пустой столбец для последующей простановки максимального к-та из п.3 среди всех строк с ключом из п.2 Собирать надо строки, которые имеют в столбце 2 значение "Прибору учета", а в столбце 18 "РУ ТП"
Затем по этой структуре данных v() надо будет пройтись, чтобы для всех строк с ключом из п.2 (сцепленные значения столбцов 4,5,10,11) найти максимальное значение коэффициента из столбца 31(п.3), где-то это запомнить(по всей видимости в тот же объект v() в столбец 5). Если есть хоть один не заполненный коэффициент для данного ключа, то максимальный коэффициент указать как Null(Empty) Затем еще раз пройтись по массиву v() и проставить в его четвертом столбце признак "ввод", если коэффициент из п.3 = максимальному коэффициенту(столбец.5) для всех строк с ключом из п.2. Если к-т меньше максимального, то "не ввод". Если значение коэффициента неизвестно(Null(Empty)) или неизвестен максимальный коэффициент(Null(Empty)), то проставить "неизвестно"
borro, представлять в виде массива данные, количество которых станет ясно только после заполнения массива — плохая, негодная идея. Для данных, которых неизвестно сколько, коллекции существуют.
У вас очень много "пройтись по массиву", может есть способ сделать несколько действий за один проход, покажите как есть и на другом листе как нужно, и покороче что от чего зависит. мне кажется есть проще решение нежели ваш код редактировать.
"Все гениальное просто, а все простое гениально!!!"
Option Explicit
Public Type Строка
Ном As Collection
Клю As Collection
Коэ As Collection
End Type
Sub Сбор()
Dim Строки As Строка
Dim i As Long
With Строки
Set .Ном = New Collection
Set .Клю = New Collection
Set .Коэ = New Collection
For i = 9 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2).Value = "Прибор учета" And Cells(i, 18).Value = "РУ ТП" Then
.Ном.Add i
.Клю.Add Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 10).Value & Cells(i, 11).Value
.Коэ.Add Cells(i, 31).Value
End If
Next i
End With
End Sub
Теперь у Вас в переменной Строки, которая является списком строк, которые Вы собираетесь анализировать, в поле Ном — номер строки, в поле Клю — ключ, в поле Коэ — коэффициент.
Всем спасибо. Если я добавлю еще и свои макросы, это скорее еще труднее станет восприниматься. Просто надо получить объект, который по номеру строки будет говорить, это устройство с максимальным коэффициентом ("ввод") или нет("не ввод") среди всех других с тем же ключом. Много пустых ячеек - это я удалил по причине безопасности
StoTisteg, попробую поработать с вашим вариантом
borro написал: устройство с максимальным коэффициентом ("ввод") или нет("не ввод") среди всех других с тем же ключом
Это тоже можно...
Код
Option Explicit
Public Type Строка
Ном As Collection
Клю As Collection
Коэ As Collection
End Type
Public Type Итог
Ключ As Collection
Макс As Collection
End Type
Sub Сбор()
Dim Строки As Строка
Dim i As Long
With Строки
Set .Ном = New Collection
Set .Клю = New Collection
Set .Коэ = New Collection
For i = 9 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2).Value = "Прибор учета" And Cells(i, 18).Value = "РУ ТП" Then
.Ном.Add i
.Клю.Add Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 10).Value & Cells(i, 11).Value
.Коэ.Add Cells(i, 31).Value
End If
Next i
End With
End Sub
Function Итоги(ByRef Строки As Строка) As Итог
Dim i As Long, Mxm As Long, Str As Long
Dim Elem As Variant
Dim sh As Worksheet
Set sh = ActiveSheet
With Итоги
Set .Ключ = New Collection
Set .Макс = New Collection
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Sheets.Count)
Cells(1, 1).Value = "Ключ"
For Each Elem In Строки.Клю
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = Elem
Next Elem
Range(Cells(1, 1), Cells(Строки.Клю.Count + 1, 1)).RemoveDuplicates Columns:=1, Header:=xlYes
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
.Ключ.Add Cells(i, 1).Value
Next i
Worksheets(Sheets.Count).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
sh.Activate
For Each Elem In .Ключ
Mxm = 0
Str = 0
For i = 1 To Строки.Клю.Count
If Строки.Клю(i) = Elem And Строки.Коэ > Mxm Then Str = Строки.Ном(i)
Next i
.Макс.Add Str
Next Elem
End Function
Функция Итоги получает список строк от макроса Сбор и возвращает список ключей и соответствующих им строк с максимальным коэффициентом.
StoTisteg, попробовал на тестовом файле. Возникает ошибка, что какой-то аргумент не указан(Argument is not optional). При этом подсвечивается код Строки.Коэ в конце вашей функции
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Function Итоги(ByRef Строки As Строка) As Итог
Dim i As Long, Mxm As Long, Str As Long
Dim Elem As Variant
Dim sh As Worksheet
Set sh = ActiveSheet
With Итоги
Set .Ключ = New Collection
Set .Макс = New Collection
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Sheets.Count)
Cells(1, 1).Value = "Ключ"
For Each Elem In Строки.Клю
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = Elem
Next Elem
Range(Cells(1, 1), Cells(Строки.Клю.Count + 1, 1)).RemoveDuplicates Columns:=1, Header:=xlYes
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
.Ключ.Add Cells(i, 1).Value
Next i
Worksheets(Sheets.Count).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
sh.Activate
For Each Elem In .Ключ
Mxm = 0
Str = 0
For i = 1 To Строки.Клю.Count
If Строки.Клю(i) = Elem And Строки.Коэ(i) > Mxm Then Str = Строки.Ном(i) ' добавил индекс в Строки.Коэ(i)
Next i
.Макс.Add Str
Next Elem
End With ' добавил окончание блока
End Function
Option Explicit
Public Type Строка
Ном As Collection
Клю As Collection
Коэ As Collection
End Type
Public Type Итог
Ключ As Collection
Макс As Collection
End Type
Sub Сбор()
Dim Строки As Строка
Dim i As Long
With Строки
Set .Ном = New Collection
Set .Клю = New Collection
Set .Коэ = New Collection
For i = 9 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2).Value = "Прибор учета" And Cells(i, 18).Value = "РУ ТП" Then
.Ном.Add i
.Клю.Add Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 10).Value & Cells(i, 11).Value
.Коэ.Add Cells(i, 31).Value
End If
Next i
End With
End Sub
Function Итоги(ByRef Строки As Строка) As Итог
Dim i As Long, Mxm As Long, Str As Long
Dim Elem As Variant
Dim sh As Worksheet
Set sh = ActiveSheet
With Итоги
Set .Ключ = New Collection
Set .Макс = New Collection
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Sheets.Count)
Cells(1, 1).Value = "Ключ"
For Each Elem In Строки.Клю
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = Elem
Next Elem
Range(Cells(1, 1), Cells(Строки.Клю.Count + 1, 1)).RemoveDuplicates Columns:=1, Header:=xlYes
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
.Ключ.Add Cells(i, 1).Value
Next i
Worksheets(Sheets.Count).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
For Each Elem In .Ключ
Mxm = 0
Str = 0
For i = 1 To Строки.Клю.Count
If Строки.Клю(i) = Elem And Строки.Коэ(i) > Mxm Then
Str = Строки.Ном(i)
Mxm = Строки.Коэ(i)
End If
Next i
.Макс.Add Str
Next Elem
End With
End Function
StoTisteg, а как теперь из результата функции Итоги по ключу получить номер строки - организовывать цикл, который сначала узнает порядковый номер ключа, а потом в следующем цикле на узнанном порядковом номере узнает номер строки?
Выход нашел через создание словаря из результата функции Итоги
Посмотрел постановку задачи в #10. На мой взгляд, оптимальный путь (по скорости и наглядности) следующий: 1. Проставить в столбце A (или ином) номера строк 2. Отсортировать таблицу по возрастанию полей 4,5,10,11 и убыванию поля 31 3. За один прогон определить признак "на вводе" (без массивов и коллекций) 4. Вернуть первоначальную сортировку, если необходимо (для этого был нужен первый пункт)