1. Формирую массив из переменных (тоже массивов): temp=Array(arr1,arr2,arr3) 2. Передаю этот массив массивов в функцию, которая оставляет в переменных только подходящие по индексу элементы Значения переменных при этом не меняются, если смотреть как ?Join(arr1) (самостоятельная переменная), но меняются, если смотреть как ?Join(arrArr(1)) (переменная в составе массива). Если, после функции фильтрации переприсваивать каждую переменную руками (arr1=arrArr(1)), то это, конечно, работает, но чёт долго
Как можно выполнить переприсваивание в цикле (или ещё как-то восстановить связь с переменными, поскольку в реале более 20 переменных бывает) и вообще почему так получается? (Так получается, потому что при формировании массива массивов теряется связь с источником — одномерными массивами)
КОД
Код
Option Explicit
'=====================================================================================
Sub t()
Dim arrArr, arrInd, x, n&, i&, crit
Dim arr0, arr1, arr2, arr3
arr0 = RngToArray1x([_0])
arr1 = RngToArray1x([_1])
arr2 = RngToArray1x([_2])
arr3 = RngToArray1x([_3])
MsgBox Join(arr0, "-") & vbLf & Join(arr1, "-") & vbLf & Join(arr2, "-") & vbLf & Join(arr3, "-")
arrArr = Array(arr0, arr1, arr2, arr3)
MsgBox Join(arrArr(0), "-") & vbLf & Join(arrArr(1), "-") & vbLf & Join(arrArr(2), "-") & vbLf & Join(arrArr(3), "-")
crit = 2: arrInd = IndexFromArrayByValue(crit, arr0)
MsgBox Join(arrInd, "-")
If Not ArrFilt(arrArr, arrInd) Then Exit Sub
MsgBox Join(arr1, "-") & vbLf & Join(arr2, "-") & vbLf & Join(arr3, "-")
MsgBox Join(arrArr(1), "-") & vbLf & Join(arrArr(2), "-") & vbLf & Join(arrArr(3), "-")
End Sub
'=====================================================================================
Function ArrFilt(ByRef arrArrays, ByVal arrIndex) As Boolean
Dim temp, x, n&, i&, u&
n = -1: u = UBound(arrArrays)
For Each x In arrIndex
n = n + 1
For i = 0 To u
arrArrays(i)(n) = arrArrays(i)(x)
Next i
Next x
For i = 0 To u
temp = arrArrays(i): ReDim Preserve temp(0 To n): arrArrays(i) = temp
Next i
ArrFilt = 1
End Function
'=====================================================================================
Function RngToArray1x(rng As Range)
Dim temp, x, n&
ReDim temp(0 To rng.Count - 1): n = -1
For Each x In rng.Value2
n = n + 1: temp(n) = x
Next x
RngToArray1x = temp
End Function
'=====================================================================================
Function IndexFromArrayByValue(ByVal valVal, ByVal arr)
Dim temp, x, i&, n&
ReDim temp(0 To UBound(arr)): i = -1: n = -1
For Each x In arr
i = i + 1: If x = valVal Then n = n + 1: temp(n) = i
Next x
ReDim Preserve temp(0 To n): IndexFromArrayByValue = temp
End Function
'=====================================================================================
'=====================================================================================
'=====================================================================================
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Добрый день, коллеги! Я не вижу никаких проблем в #1. В макросе t массив arrarr содержит 4 элемента, каждый из которых является массивом. Эти элементы не являются ссылкой на arr0, arr1,..., как это было бы в случае с объектами, a живут собственной жизнью. Естественно, их изменение никак не может затронуть arr0,...
sokol92, спасибо! А как в таком случае сделать правильно? Чтобы передавать переменные и менялись именно они… Может UDF написать надо (какого рода) или класс создать (пока не делал)?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
ivanok_v2, насколько я понимаю, это как раз вообще ничего не изменит во входящих данных. В таком случае придётся переделать функцию, чтобы возвращала массив массивов, а не изменяла входящий. Вы пробовали?
я невнимательно прочитал, переставив местами — прошу прощения… В таком случае, непонятно - где (в какой функции) менять и как это может помочь? В основной функции для фильтрации как раз стоит ByRef (хотя можно было и не писать, т.к. он по-умолчанию подразумевается программой)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Алексей, 1. переходите от MSGBOX на debug.print . 2. при передаче значения в дочерней функции создается новый элемент. При ссылке работа ведется с тем что передали. Соответственно, если хотите менять то передавайте ссылку. Если правильно помню, то по умолчанию, если ничего не прописывать то ссылка будет и b будет 2
Скрытый текст
Код
Sub test()
B = 1
A = Test1(B, 2)
Debug.Print B
B = 1
A = Test2(B, 2)
Debug.Print B
B = 1
A = Test3(B, 2)
Debug.Print B
End SubFunction Test1(C, d)
Ñ = Ñ * d
Test1 = True
End Function
Function Test2(ByRef C, d)
Ñ = Ñ * d
Test2 = True
End FunctionFunction Test3(ByVal C, d)
Ñ = Ñ * d
Test3 = True
End Function
Jack Famous написал: А как в таком случае сделать правильно
Пример для двумерного массива (в отладчике можно посмотреть на массив "a" в конце макроса test) :
Код
' Обрабатывает двумерный массив и к текстовым значениям, начинающимся на апостроф и знак равенства, добавляет слева апостроф
Sub RngChg(ByRef arr())
Dim i As Long, j As Long
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
If Left(arr(i, j), 1) = "=" Or Left(arr(i, j), 1) = "'" Then
arr(i, j) = "'" & arr(i, j)
End If
Next j
Next i
End Sub
Sub test()
Dim a(1 To 2, 1 To 5)
a(2, 3) = "'Литерал SQL'"
a(2, 5) = "=формула"
a(1, 1) = 5454 ' число
a(1, 2) = "Обычный текст"
RngChg a
End Sub
спасибо — уже давно использую (особенно с длинными строками), а тут MsgBox остался для пошаговой отладки
БМВ, sokol92, по примерам в целом понятно, но неясно главное — как это применить для моего примера
Дело в том, что переменные одномерных массивов с нуля из примера (arr1, arr2 и т.д.) в реальности представляют собой целые столбцы данных из разных файлов. То есть, я открываю файл-программу (например для списания) и, при запуске, из разных справочников забираются вот такие массивы (бывает более 20ти). Public-переменные для них хранятся в надстройке. Вот наполнил я эти переменные и потом начинаю фильтровать под разные задачи - для этого и написал функцию фильтрации по массиву индексов. А передаю массив массивов, потому что не ясно - сколько массивов будет фильтроваться, а массив массивов всегда один. Можно передать один одномерный массив (частный случай). Как-то так:
Парочка реальных UDF
Код
Public Function PRDX_ArraysFilter(ByRef arrArrays1x, ByVal arrIndex, Optional ByVal OneArray1x As Boolean) As Boolean
Dim temp, x, y, n&, i&, u&
If Not PRDX_IsArray(arrIndex, 1) Then MsgBox "Массив индексов некорректен!", vbCritical, "PRDX_ArrayFilter": Exit Function
If OneArray1x Then arrArrays1x = Array(arrArrays1x)
If Not PRDX_IsArray1xMulti(arrArrays1x) Then MsgBox "Массив массивов некорректен!", vbCritical, "PRDX_ArrayFilter": Exit Function Else n = -1: u = UBound(arrArrays1x)
For Each x In arrIndex
n = n + 1
For i = 0 To u
arrArrays1x(i)(n) = arrArrays1x(i)(x)
Next i
Next x
For i = 0 To u
temp = arrArrays1x(i): ReDim Preserve temp(0 To n): arrArrays1x(i) = temp
Next i
PRDX_ArraysFilter = 1
End Function
'=============================================
Public Function PRDX_IsArray1xMulti(arr) As Boolean
Dim x, u&
On Error GoTo er: u = UBound(arr(0))
For Each x In arr
If LBound(x) <> 0 Then GoTo er
If UBound(x) <> u Then GoTo er
Next x
PRDX_IsArray1xMulti = 1
er: Err.Clear
End Function
Если можно, то покажите на моём примере передачи массива массивов — как потом эти исходные массивы (arr1, arr2 и т.д.) можно быстро "актуализировать" (если это вообще реализуемо)…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Здравствуйте, Алексей! Трудно давать советы, не зная в деталях сущность задачи. Если Вы изначально рассчитываете, что будете работать с массивом массивов, то зачем "одиночные" массивы? Работайте в #1 сразу с ArrArr (изменен только стартовый макрос):
Код
Sub t()
Dim arrArr, arrInd, x, crit
ReDim arrArr(0 To 3)
arrArr(0) = RngToArray1x([_0])
arrArr(1) = RngToArray1x([_1])
arrArr(2) = RngToArray1x([_2])
arrArr(3) = RngToArray1x([_3])
crit = 2: arrInd = IndexFromArrayByValue(crit, arrArr(0))
If Not ArrFilt(arrArr, arrInd) Then Exit Sub
' ...
End Sub
Чтобы часто не менять размерность arrArr можно изначально распределить его с запасом (например, на 1000 элементов, это потребует по нынешним временам немного дополнительной памяти) и в отдельной переменной типа long хранить последний занятый элемент. Естественно, эту переменную нужно предусмотреть и в обрабатывающих процедурах.
Здравствуйте, Владимир По описанной выше (и подробнее в #11) причине.
Смотрите: заменим arr'ки из примера на более реальные arrName, arrVal, arrMeas, arrPrice и arrCost. Каждый из этих массивов представляет собой столбец одной и той же таблицы в другом файле (Наименование, КОЛ-ВО, Ед. изм., Цена и Стоимость — соответственно). И вот мне нужно как бы "отфильтровать" все эти массивы-столбцы, оставив только нужные (одинаковые для каждого) индексы (массив индексов получен отдельно). Для этого была написана функция. Главный вопрос - можно ли каким-то образом ТАК передать эти массивы в неё через массив массивов, чтобы после работы функции сами эти одиночные массивы изменились?
Я так понимаю, что как раз из-за формирования массива массивов это невозможно.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub jjj_main()
Dim arr1(): arr1 = VBA.Array(1, 2, 3, 4)
Dim arr2(): arr2 = VBA.Array(5, 6, 7, 8)
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Call jjj_arrs_change(dict, arr1, arr2)
arr1 = dict(1)
arr2 = dict(2)
Debug.Print Join(arr1, ", ")
Debug.Print Join(arr2, ", ")
End Sub
Sub jjj_arrs_change(ByRef dict As Object, ParamArray arrs())
Dim arr, arr_item
Dim lCnt&: lCnt = 0
For Each arr In arrs
For arr_item = LBound(arr) To UBound(arr)
arr(arr_item) = arr(arr_item) * 2
Next arr_item
lCnt = lCnt + 1
dict(lCnt) = arr
Next arr
End Sub
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Ваша задумка с ParamArray не увенчается успехом, т.к. он принимает ТОЛЬКО значения, но не ссылки на объекты. (судя из справки и по экспериментам, которые я первым делом провёл) +++ Тогда, возможно, так...
Скрытый текст
Код
Sub jjj_main()
Dim arrs(): arrs = VBA.Array(VBA.Array(1, 2, 3, 4), VBA.Array(5, 6, 7, 8))
arrs = jjj_arrs_change(arrs)
Debug.Print Join(arrs(0), ", ")
Debug.Print Join(arrs(1), ", ")
End Sub
Function jjj_arrs_change(arrs)
Dim i&, j&
For i = LBound(arrs, 1) To UBound(arrs, 1)
For j = LBound(arrs(i), 1) To UBound(arrs(i), 1)
arrs(i)(j) = arrs(i)(j) * 2
Next j
Next i
jjj_arrs_change = arrs
End Function
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
JayBhagavan, ну, во-первых, я тогда еще не пробовал ваш вариант)) во-вторых вы в своём примере точно также делаете Join по элементам массива массивов и переменными там не пахнет))) видимо, всё-таки, буду ручками
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous, Join я делаю для наглядности, что содержимое массива массивов изменилось. Зачем ещё какие-то переменные мне НЕ понятно, когда можно обращаться к подмассиву по его индексу. Если Вы про наглядность в имени массива:
Цитата
arrName, arrVal, arrMeas, arrPrice и arrCost
так сделайте индексы подмассивов константами, например:
Мужики, ну вы чего в самом деле?))))) Я же уже столько раз написал, что переменные мне нужны, потому что в них хранятся данные с других листов и после фильтрации прочие процедуры и функции обращаются к заранее известным переменным, а не к элементам массива массивов вот я и ищу, можно ли как-то "не руками" их после фильтрации переназначить…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄