powered by simpleCommunicator - 2.0.55     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Массивы в VBA
69 сообщений из 69, показаны все 3 страниц
Массивы в VBA
    #36375547
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Помогите с заданием на массивы пожалуйста:

Дано:
сумма элементов, не принадлежащих главной диагонали
83216
24590
68172
35068
17429

Вычислить произведение элементов 4-ой строки, больших 3.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375695
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А "сколько лет учительнице"(с) не требуется вычислить?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375717
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Это написать в VBA нужно, я с ним плохо дружу.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375743
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
да мы напишем, напиши ЧТО нужно написать на ВБА

наверное , дана матрица, предположительно с какими-то ограничениями, возможно размером 5х5, вероятно главная диагональ - это элементы (1,1),(2,2) и т.п., может быть есть определенный принцип заполнения этой матрицы, скорее всего есть математическое решение задачи, будь добр его описать.

по моему опыту, если автор ленится описать подробно, что ему нужно, результат игры в угадайку будеи примерно через неделю, когда заглянет кто-то из редких гостей и сходу угадает, что же нужно было автору.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375798
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Я всё понимаю, полностью согласен. В том и проблема, что это всё, что дано) Может быть было какое-то дополнительное условие, но судя по тому, что есть у меня на фотографии, очень сомневаюсь. Я расписал в первом сообщении всё задании
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375829
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
LostarПомогите с заданием на массивы пожалуйста:
Дано:
сумма элементов, не принадлежащих главной диагонали
83216
24590
68172
35068
17429
Вычислить произведение элементов 4-ой строки, больших 3.

Явно что-то не хватает в исходных данных.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375832
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Уговорили, попробую разузнать, тогда отпишусь
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375836
calc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
LostarП
Вычислить произведение элементов 4-ой строки, больших 3.
240 ? :-)
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375843
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
calcLostarП
Вычислить произведение элементов 4-ой строки, больших 3.
240 ? :-)
5 * 6 * 8 = 240
Вам не кажется, что очень просто?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375853
calc
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
.Михаил.calcLostarП
Вычислить произведение элементов 4-ой строки, больших 3.
240 ? :-)
5 * 6 * 8 = 240
Вам не кажется, что очень просто?
кажется...а есть другие версии?

авторэто всё, что дано
...
Рейтинг: 0 / 0
Массивы в VBA
    #36375882
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо огромное, а я парился сидел! И правда, зачем писать всё это в программе, я лучше устно отвечу))). Я думаю меня либо пошлют на другую специальность, либо просто пошлют)
...
Рейтинг: 0 / 0
Массивы в VBA
    #36376051
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.calcLostarП
Вычислить произведение элементов 4-ой строки, больших 3.
240 ? :-)
5 * 6 * 8 = 240
Вам не кажется, что очень просто?

а вам не кажется, что 35068 - это не сама строка, а именно сумма?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36376185
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro.Михаил.calcLostarП
Вычислить произведение элементов 4-ой строки, больших 3.
240 ? :-)
5 * 6 * 8 = 240
Вам не кажется, что очень просто?

а вам не кажется, что 35068 - это не сама строка, а именно сумма?
Согласен: тогда получается это матрица 5х5; суммы построчных элементов исключая элементы главной диагонали приведены в исходных данных. Необходимо при данных условиях найти каждый элемент этой матрицы. Но как было сказано выше, такое очучение, чего-то в условиях не хватает.
Lostas
Вычислить произведение элементов 4-ой строки, больших 3.

Если найти элементы 4-ой строки, сумма которых = 35068, то, по-моему, каждый элемент должен больше чем 3, не так ли? Слишком маленькая эта цифра 3 в исходных данных?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36376245
Lostar
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Неудобно вас загружать этим заданием, в понедельник постараюсь всё выяснить досканально. Спасибо за поддержку, как выясню, напишу.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519273
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Хорошее название темы...
Тогда не надо создавать другую :)
Вопрос короткий:
Получен массив с данными XArray() неизвестной размерности...
Нужно получить значение элемента массива с адресом XAddress полученном в виде:
1. XAddress=Array(X1,X2,X3,....,Xn), где n - может быть любой, но вседа соответствует n-мерности массива
ИЛИ
2. XAddress="X1,X2,X3,....,Xn"
Одним словом нужно что-то типа:
XElement=XArray(XAddress)
В каком виде или какого типа нужно представить XAddress, что сработало?...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519288
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrХорошее название темы...
Тогда не надо создавать другую :)

Когда вам будут делать укол, попросите сделать его шприцом от предыдущего пациента, потому что он еще хороший и почти новый.

Лучше создайте новый топик и попытайтесь все-таки чуть попонятней объяснить. Я вот так и не понял XAddress - это входные данные или выходные данные? и какого типа входные данные и результат? Попробуйте привести пример что ли....
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519313
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AlexFr,

Код: plaintext
1.
2.
3.
4.
5.
6.
Sub arr_primer()
arr = Array("один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять")
For i = LBound(arr) To UBound(arr)
MsgBox i & " элемент = " & arr(i)
Next
End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519337
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,
Option Base 1
Sub CreateSamp()
Dim XArray(10, 10) As Integer
For X = 1 To 10
For Y = 1 To 10
XArray(X, Y) = X + Y - 1
Next Y
Next X
XAddress = Array(1, 5)
XElement = XArray(1, 5) ' А хтелось бы что-то типа XElement = XArray(XAddress)
End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519356
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Если вы хотите вырезать кусок из массива, то почему тогда XAddress сам представлен в виде массива, причем незаполненного?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519360
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
может что-то типа вот этого?
Код: plaintext
XElement = XArray(Ubound(XAddress, 1 ), Ubound(XAddress, 2 ))
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519386
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

Наверно я не достаточно исчерпывающе изложил... :(
Попробую по другому:

Sub CreateSamp()
Dim XArray(10, 10) As Integer
For X = 1 To 10
For Y = 1 To 10
XArray(X, Y) = Rnd
Next Y
Next X
XElement = XArray(1, 5)
NADO_XElement = XFunc(XArray, "1,5") 'Вот такую функцию сочиняю, а как применить "1,5"?
Stop
Dim XArray1(10, 10, 10) As Integer
For X = 1 To 10
For Y = 1 To 10
For Z = 1 To 10
XArray1(X, Y, Z) = Rnd
Next Z
Next Y
Next X
XElement = XArray1(1, 5, 3)
NADO_XElement = XFunc(XArray1, "1,5,3") 'Вот такую функцию сочиняю, а как применить "1,5,3"?
Stop
End Sub

Public Function XFunc(XArrayFunc, StringAddr)

End Function
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519409
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
XElement = XArray1(1, 5, ..., n) и NADO_XElement = XFunc(XArray1, "1,5,...,n") - это одно и тоже значение
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519505
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFr,

Я нифига не могу понять, что вам надо.

Разложить текстовую строку в массив - функция Split
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519880
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Public Function XFunc(XArrayFunc, StringAddr)
' Массив получаю в XArrayFunc
' Адрес элемента массива получаю в StringAddr, но в текстовом виде, грубо говоря...
' Нужно из массива XArrayFunc извлеч его элемент с адресом StringAddr... Как?

End Function
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519898
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AlexFr,

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Public Function XFunc(XArrayFunc, StringAddr)
' Массив получаю в XArrayFunc
' Адрес элемента массива получаю в StringAddr, но в текстовом виде, грубо говоря...
' Нужно из массива XArrayFunc извлеч его элемент с адресом StringAddr... Как?
XFunc = XArrayFunc(Val(StringAddr))
End Function

Sub ttt()
arr = Array("один", "два", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять")
test = XFunc(arr, "1")
MsgBox test
End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519903
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrPublic Function XFunc(XArrayFunc, StringAddr)
' Массив получаю в XArrayFunc
' Адрес элемента массива получаю в StringAddr, но в текстовом виде, грубо говоря...
' Нужно из массива XArrayFunc извлеч его элемент с адресом StringAddr... Как?

End Function

Ага, стало яснее.
При этом массив совершенно произвольного количества измерений или есть какое-то ограничение?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519911
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Hugo121,

А если он двух.. трех.. n-мерный?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36519912
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

нет ограничений...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520019
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrXElement = XArray1(1, 5, ..., n) и NADO_XElement = XFunc(XArray1, "1,5,...,n") - это одно и тоже значение
голову сломал, пока это придумывал
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Sub myTest()
Dim mass( 1  To  10 ,  1  To  10 ,  1  To  10 ) As Integer ' можно сделать любую размерность
Dim i As Integer, j As Integer, i1 As Integer, pos As Integer
pos =  0 
For i =  1  To  10 
    For j =  1  To  10 
        For i1 =  1  To  10 
            pos = pos +  1 
            mass(i, j, i1) = pos
        Next
    Next
Next
MsgBox XFunc(mass, "1,3,4") & " " & mass( 1 ,  3 ,  4 ) ' для сравнения результатов
End Sub
сама функция
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
Function XFunc(ByRef XArray, ByRef StringAddr As String) As Integer
Dim addr() As String, n As Integer, val2 As Integer, val() As Integer, myItem
Dim i As Integer, pos() As Integer, flag As Byte, m As Integer
n =  1 : addr = Split(StringAddr, ",")
On Error GoTo ErrorHandler
    Do
        val2 = UBound(XArray, n)
        n = n +  1 
    Loop Until False
ErrorHandler:
n = n -  1  ' n - мерность массива XArray
ReDim val( 1  To n): ReDim pos( 1  To n)
For i =  1  To n
    val(i) = UBound(XArray, n)
    pos(i) =  1 
Next
If (UBound(addr) +  1 ) <> n Then ' проверка
    MsgBox "Размерности массива XArray и адресной строки StringAddr неодинаковы"
    XFunc = - 1 
Else
    For Each myItem In XArray
        'MsgBox myItem
        flag =  0 
        For i =  1  To n
            If pos(i) = CInt(addr(i -  1 )) Then flag = flag +  1 
        Next
        If flag = n Then
            XFunc = myItem
            Exit Function
        End If
        For m =  1  To n
            If m =  1  Then pos(m) = pos(m) +  1 
            If pos(m) > val(m) Then
                pos(m) =  1 
                If (m +  1 ) <= n Then pos(m +  1 ) = pos(m +  1 ) +  1 
            End If
        Next
    Next
End If
End Function
может что-то работать неправильно и много воды, но, надеюсь, направит в правильном направлении
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520316
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.много воды

Респект, Михаил, хорошая идея.

Я тут попробовал переделать внутренний цикл, потому как не понял всех ваших изысканий:
Код: plaintext
1.
2.
3.
4.
5.
6.
    i =  0 
    m = (addr( 2 ) -  1 ) *  100  + (addr( 1 ) -  1 ) *  10  + addr( 0 )
    For Each myItem In XArray
      i = i +  1 
      If i = m Then Exit For
    Next
    XFunc = myItem
m правда рассчитывается исходя из ваших конкретных данных, но суть понятна, можно переделать на цикл.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520532
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro потому как не понял всех ваших изысканий
суть в чем:
1. Для начало надо получить значение n размерности массива, n задается в некой внешней процедуре (функции), мы не знаем значение n :
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
n =  1 
On Error GoTo ErrorHandler 
    Do
        val2 = UBound(XArray, n) ' если не произошла ошибка (отлов ошибки) , то
        n = n +  1  ' к n прибавляется +1
    Loop Until False
ErrorHandler:
n = n -  1  ' n - мерность массива XArray
ХЗ, но почему-то получается результат на 1 больше, чем надо, не стал заморачиваться и уменьшил его на -1.

2. Далее "инициализую" две переменные в виде массивов равных n-размерности:
первая, val : максимальное значение элементов массива в каждой n-размерности;
вторая, pos : некий счетчик шагов для каждой n-размерности.
Код: plaintext
1.
2.
3.
4.
5.
ReDim val( 1  To n): ReDim pos( 1  To n)
For i =  1  To n
    val(i) = UBound(XArray, n)
    pos(i) =  1 
Next

3. Далее этот некий счетчик эмитирует прозождение цикла. При совпадении значение счетчика со значениями строки StringAddr цикл останавливается и получается "результат".
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
For Each myItem In XArray
        flag =  0  ' флаг
        For i =  1  To n 
            If pos(i) = CInt(addr(i -  1 )) Then flag = flag +  1  
            ' сравнение значений счетчика с со значениями строки StringAddr
        Next
        If flag = n Then ' если все n совпали, то результат 
            XFunc = myItem
            Exit Function
        End If
        ' это эмитация прохождения цикла
        ' сначало проходит первую размерность (n=1), увеличивая на каждом шаге на +1
        ' при достижении максимального значения в n=1, в n=2 увеличиваю на +1 и так далее до n
        For m =  1  To n
            If m =  1  Then pos(m) = pos(m) +  1 
            If pos(m) > val(m) Then
                pos(m) =  1 
                If (m +  1 ) <= n Then pos(m +  1 ) = pos(m +  1 ) +  1 
            End If
        Next
    Next
Shocker.Pro Я тут попробовал переделать внутренний цикл
на скока я вижу "переделка" для размерности n=3, а также исходный массив иницализировать можно различными способами...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520569
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.
Shocker.Pro Я тут попробовал переделать внутренний цикл
на скока я вижу "переделка" для размерности n=3, а также исходный массив иницализировать можно различными способами...

Ну я написал, что он для фиксированных величин, а на самом деле надо доработать - устроить цикл вычисления "m" по результатам предшествующих проверок размерности. Я просто попробовал вычислить индекс заранее и свести цикл просто к переходу на нужный элемент.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520635
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
.Михаил.,

Вакцина подействовала!!! :)
Спасибо!
Больному лучше..
К вечеру даже "выпишусь", наверно...
Проверка соответствия размерность массива - размерность адреса не требуется, т. к. заведомо по условию задачи верна (уже в другой процедуре сделана), а вот переход к нужному элементу по более короткому пути попробую седня вечером сделать.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520661
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.счетчик эмитирует прохождение цикла

Ну раз все хорошо, то в качестве занудства:
Эмитировать
Имитировать
...
Рейтинг: 0 / 0
Массивы в VBA
    #36520699
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro.Михаил.счетчик эмитирует прохождение цикла

Ну раз все хорошо, то в качестве занудства:
Эмитировать
Имитировать


Сенк за ошибку. Понадеелся на Word, ошибку мне не показал...
-1
...
Рейтинг: 0 / 0
Массивы в VBA
    #36521414
Фотография vlth
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.
Код: plaintext
Dim mass( 1  To  10 ,  1  To  10 ,  1  To  10 ) As Integer ' можно сделать любую размерность


Всё хорошо, пока кол-во "строк", "столбцов" и т.д. в массиве совпадают. Проверьте
Код: plaintext
1.
2.
3.
Dim mass( 1  To  5 ,  1  To  10 ,  1  To  10 ) As Integer
...
For i =  1  To  5 
...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36521453
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
vlth,
Уже опять все хорошо :-)))

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Option Base  1 

Sub myTest()
Dim mass( 1  To  10 ,  1  To  10 ,  1  To  10 ) As Integer ' можно сделать любую размерность
Dim i As Integer, j As Integer, i1 As Integer, pos As Integer
pos =  0 
For i =  1  To  10 
    For j =  1  To  10 
        For i1 =  1  To  10 
            pos = pos +  1 
            mass(i, j, i1) = pos
        Next
    Next
Next
MsgBox XFunc(mass, "1,3,4") & Chr( 10 ) & mass( 1 ,  3 ,  4 )   ' для сравнения результатов
Dim XArray1( 8 ,  9 ) As Integer
For X =  1  To  8 
For Y =  1  To  9 
XArray1(X, Y) = Y + X *  10 
Next Y
Next X
MsgBox XFunc(XArray1, "2,5") & Chr( 10 ) & XArray1( 2 ,  5 )  ' для сравнения результатов
Dim arr() As Variant
arr = Array( 11 ,  22 ,  33 ,  44 ,  55 ,  66 ,  77 ,  88 ,  99 )
MsgBox XFunc(arr, "2") & Chr( 10 ) & arr( 2 )   ' для сравнения результатов
End Sub

Function XFunc(ByRef XArray, ByRef StringAddr As String) As Integer
n = UBound(Split(StringAddr, ","))
NN = CInt(Split(StringAddr, ",")( 0 ))
UbxUb =  1 
For n1 =  1  To n
 UbxUb = UbxUb * UBound(XArray, n1)
 NN = NN + (CInt(Split(StringAddr, ",")(n1)) -  1 ) * UbxUb
Next n1
NNN =  0 
For Each myItem In XArray
 NNN = NNN +  1 
 If NNN = NN Then
  XFunc = myItem
  Exit Function
 End If
Next
...
Рейтинг: 0 / 0
Массивы в VBA
    #36521524
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
И финал будет фантастическим, если есть функция, с родни
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
For Each myItem In XArray
 NNN = NNN +  1 
 If NNN = NN Then
  XFunc = myItem
  Exit Function
 End If
Next
, которая просто возвращает значение порядкового элемента NN из последовательности перебора... 8-)
...
Рейтинг: 0 / 0
Массивы в VBA
    #36532959
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Доброго времени суток!

Public Function CreateArrayFunc(CreateArrayName, CreateArrayString)
' Имя массива получаю в CreateArrayName
' Размерность массива получаю в CreateArrayString, но в текстовом виде, грубо говоря...
' Нужен массив
End Function

Общий пример: CreateArrayName="CrArr" , CreateArrayString="X1,X2,X3,...,Xn"
X - какие-то целые числа
n - кол-во измерений массива, определяется поступившими данными, заранее не известно

Частный пример аргументов:
CreateArrayName="CrArr"
CreateArrayString="7,5,9,3,6"
'CreateArrayFunc должна выполнить действие: Dim CrArr(7,5,9,3,6) As Double
или
CreateArrayName="CrArr"
CreateArrayString="7,5,9,3,6,45,21,8,1"
'CreateArrayFunc должна выполнить действие: Dim CrArr(7,5,9,3,6,45,21,8,1) As Double

Если кому интересно, то данная необходимость возникла по причине записи данных наблюдения за физическими объектами в различном кол-ве и различного типа, особенно в случае статистического анализа с целью вычисления функции их поведения, где n необходимое кол-во измерений массива или мерности функции (ранг). Значение этой переменной растет до достижения точности соответствия полученной функции фактическому поведению объекта и заранее не известна…
Т. к. я далеко не прошник в VBA, а пользуюсь им для решения технических проблем, то вот и завис…
В прошлый раз Михаил успешно предложил способ последовательного перебора, спасибо ему...
Сейчас задача другая...
Если кто-то отправит меня в нужном направлении – буду признателен, а то сам ничего подобного не нашел…
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533040
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFr,

Мне кажется, вам надо отказаться от идеи с массивами и воспользовать коллекциями.
прямо будете давать ключи в виде текстовой константы - "1,2,5"
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533166
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrДоброго времени суток!

Public Function CreateArrayFunc(CreateArrayName, CreateArrayString)
' Имя массива получаю в CreateArrayName
' Размерность массива получаю в CreateArrayString, но в текстовом виде, грубо говоря...
' Нужен массив
End Function

Общий пример: CreateArrayName="CrArr" , CreateArrayString="X1,X2,X3,...,Xn"
X - какие-то целые числа
n - кол-во измерений массива, определяется поступившими данными, заранее не известно

Частный пример аргументов:
CreateArrayName="CrArr"
CreateArrayString="7,5,9,3,6"
'CreateArrayFunc должна выполнить действие: Dim CrArr(7,5,9,3,6) As Double
или
CreateArrayName="CrArr"
CreateArrayString="7,5,9,3,6,45,21,8,1"
'CreateArrayFunc должна выполнить действие: Dim CrArr(7,5,9,3,6,45,21,8,1) As Double

Задать имя массива через строку как Вы хотите нельзя. Имя массива задается только при его описании: Dim CrArr() As Double; CrArr - это ссылка на начало массива в символьном выражении.
Код: plaintext
1.
2.
3.
4.
...
CreateArrayFunc("CrArr", "7,5,9,3,6,45,21,8,1")
...
MsgBox CrArr( 1 ) ' должно показать 7 или 5
см. пример: у Вас так никогда не получится, забудьте об этом

Для решения Вашей задачи можно создать класс (или структуру - собственный тип дынных), в котором будут содержаться все наименования созданных вами массивов в виде строки, а также ссылки на сами массивы. Можно также создать метод (или процедуру), который будет возвращать тот или иной массив по его названию.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533195
Фотография vlth
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
.Михаил.Задать имя массива через строку как Вы хотите нельзя. Имя массива задается только при его описании: Dim CrArr() As Double; CrArr - это ссылка на начало массива в символьном выражении. Фраза выше на мысль навела: м.б. создавать процедуру или функцию динамически?
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533218
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.ProМне кажется, вам надо отказаться от идеи с массивами и воспользовать коллекциями.
прямо будете давать ключи в виде текстовой константы - "1,2,5"
Думал, но последующее использование будет выглядеть громоздко, т. к. в дальнейшем используется матаппарат для обработки матриц. По сути это работа с цифрами. Например,
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Function XFunc(ByRef XArray, ByRef StringAddr As String) As Integer
n = UBound(Split(StringAddr, ","))
NN = CInt(Split(StringAddr, ",")( 0 ))
UbxUb =  1 
For n1 =  1  To n
 UbxUb = UbxUb * UBound(XArray, n1)
 NN = NN + (CInt(Split(StringAddr, ",")(n1)) -  1 ) * UbxUb
Next n1
NNN =  0 
For Each myItem In XArray
 NNN = NNN +  1 
 If NNN = NN Then
  XFunc = myItem
  Exit Function
 End If
Next
которая обсуждалась раньше...
.Михаил.Для решения Вашей задачи можно создать класс (или структуру - собственный тип дынных), в котором будут содержаться все наименования созданных вами массивов в виде строки, а также ссылки на сами массивы. Можно также создать метод (или процедуру), который будет возвращать тот или иной массив по его названию.
т.е., если я правильно понял, нужно создать набор, типа, конструктор, элементы которого уже готовы, а потом их брать и применять ("ссылки на сами массивы")? Но предполагаемое разнообразие убивает... :( Или я не правильно понял...
vlthФраза выше на мысль навела: м.б. создавать процедуру или функцию динамически?
А можно кусочек примера? :) Типа, теряюсь... :))
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533222
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrДумал, но последующее использование будет выглядеть громоздко, т. к. в дальнейшем используется матаппарат для обработки матриц.

Почему? Это наоборот - упрощает дело, поскольку для доступа к определенному элементу массива, вам вообще не нужен будет приведенный кусок кода. То есть переменную StringAddr вы будете использовать "как есть" - MyCollection(StringAddr) без всякого разбора на индексы.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533232
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

Да, но как автоматом создать произвольную MyCollection(StringAddr) для дальнейшего использования, еслия знаю тока размерность (ранг)...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533247
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
Dim MyCollection As New Collection
"размер не имеет значения" (с)
"они безразмерные!" (с)
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533251
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Dim i As Integer, j As Integer, k As Integer
Dim MyCollection As New Collection

For i =  1  To  5 
  For j =  1  To  10 
    For k =  1  To  18 
      MyCollection.Add Rnd( 0 ), CStr(i) + "," + CStr(j) + "," + CStr(k)
    Next
  Next
Next

MsgBox MyCollection("3,4,8")
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533269
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А далее, чтобы иметь набор именованных массивов вы можете создавать коллекцию коллекций.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Dim GlobalColl As New Collection
Dim j As Collection

Set j = New Collection
GlobalColl.Add j, "ложки"
Set j = Nothing
Set j = New Collection
GlobalColl.Add j, "вилки"
Set j = Nothing
Set j = New Collection
GlobalColl.Add j, "поварешки"
Set j = Nothing

'обращение к элементу нужного массива (после инициализации)
GlobalColl("вилки")("2,3,7")
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533277
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

Да-да-да я понял, просто хотелось чего-то структурированного, тем более уменя ужо машина налажена, но работала тупо по трехмеркам, например... Поентому я пытался пробить развитие системы в томже духе, но похоже придется все переделывать, апргрейд не удался... :))
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533320
Фотография vlth
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFrА можно кусочек примера? :) Типа, теряюсь... :))
Ну вот и "кусочек"... Программно создаётся модуль basTwo, в нём запускается процедура TMP(), выводящая в цикле элементы массива в окно отладки. Наверное, сие можно довести до ума.
Только не забудьте поставить ссылку на Microsoft Visual Basic xx Extensibility. И доверие для доступа к Visual Basic Project, наверное, надо поставить.
Для удаления basTwo запускайте test2 (из процедуры test удалить его не получилось)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Public Sub CreateArray(CreateArrayName As String, CreateArrayString As String)
With Application.VBE.ActiveVBProject
    With .VBComponents.Add(vbext_ct_StdModule)
        .Name = "basTwo"
        With .CodeModule
            .AddFromString "Public " & CreateArrayName & "() As Variant"
            .AddFromString "Sub TMP()" & vbCrLf & CreateArrayName & _
                "= Array(" & CreateArrayString & ")" & vbCrLf & _
                "For i = 0 To UBound(" & CreateArrayName & ")" & vbCrLf & _
                "Debug.Print " & CreateArrayName & "(i)" & vbCrLf & _
                "Next" & vbCrLf & _
                "End Sub"
        End With
    End With
End With
End Sub
Sub test()
CreateArray "CrArr", "7,5,9,3,6"
Application.OnTime Now + TimeValue("00:00:01"), "TMP"
End Sub
Sub test2()
RemoveModule "basTwo"
End Sub
Private Sub RemoveModule(NameOfModule)
With ThisWorkbook.VBProject
    .VBComponents.Remove .VBComponents(NameOfModule)
End With
End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533338
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
vlth,
ВО, спасибо, а то я уж больше часа как раз там да около возюкаюсь...
Что-то проясняется... :))
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533398
Фотография vlth
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AlexFr, вот так удаление модуля, вроде, нормально срабатывает:
Код: plaintext
1.
2.
3.
4.
Sub test()
CreateArray "CrArr", "7,5,9,3,6"
Application.OnTime Now + TimeValue("00:00:01"), "TMP"
Application.OnTime Now + TimeValue("00:00:02"), "test2"
End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #36533414
AlexFr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
vlth,

Да-да, спасибо, я ужо структуру ваяю, чтоб она более ликвидно и доступно выглядела...
Можно даже лог сделать - просто супер, или "базу" наиболее часто используемых операций, дабы не запускать каждый раз процедуру по полной. Пару дней над структурой попарюсь (творческий процесс :) ), а потом все выложу. Вдруг кому интересен такой набор инструментов окажется...
...
Рейтинг: 0 / 0
Массивы в VBA
    #36534497
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Dim i As Integer, j As Integer, k As Integer
Dim MyCollection As New Collection

For i =  1  To  5 
  For j =  1  To  10 
    For k =  1  To  18 
      MyCollection.Add Rnd( 0 ), CStr(i) + "," + CStr(j) + "," + CStr(k)
    Next
  Next
Next

MsgBox MyCollection("3,4,8")
Интересный пример, думаю мне это пригодиться.
Но у меня возник вопрос. Смотрю в VBA в окне локальных переменных данную коллекцию.
Там я лишь вижу элементы вида Item X=Y, где X номер элемента в коллекции, а Y значение данного элемента.
Вопрос, как узнать название коллекции для конкретного элемента ItemX.
Т.е. смотря на некий элемент, например в данном примере Item 1, как узнать, что его имя "1,1,1".
Возможно с терминологией я попутал, т.к. свои коллекции я ранее не создавал.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36534546
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Никак.

Если это действительно требуется, тогда задача немного усложняется.
Как вы уже наверное поняли, элементом коллекции может быть не только просто переменная, но и экземпляр класса.
Таким образом, нужно создать собственный класс "с блэкджеком и шлюхами" и заодно со свойством "Name" и заполнять коллекцию экземплярами этого класса. То есть "1,1,1" вы зададите два раза, как свойство "Name" экземпляра класса, так и как ключ коллекции.

Класс в простейшем случае может содержать только две строки
Код: plaintext
1.
Public Value As Variant
Public Name As String
...
Рейтинг: 0 / 0
Массивы в VBA
    #36534568
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.ProНикак.Жаль конечно, что напрямую VBA это не показывает.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36534705
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Djon PlayerЖаль конечно, что напрямую VBA это не показывает.

Если сделаете через класс - будет показывать.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36534879
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Поискал, нашёл пару вариантов решения этой проблемы:
/topic/257224
...
Рейтинг: 0 / 0
Массивы в VBA
    #36987211
Daniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Дана последовательность чисел ak(k=1,2,....n).Выбрать числа кратные 5 и подсчитать их число и найти их сумму.
...
Рейтинг: 0 / 0
Массивы в VBA
    #36987255
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
DaniskinДана последовательность чисел ak(k=1,2,....n).Выбрать числа кратные 5 и подсчитать их число и найти их сумму.очень интересно.
...
Рейтинг: 0 / 0
Массивы в VBA
    #37055422
Van-Gog
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
помогите решить Записать элементы массива X=(x1,x2,…, xn) в обратном порядке в массив Y=(y1,y2,…, yn). Вычислить сумму элементов массива Y с нечетными индексами
...
Рейтинг: 0 / 0
Массивы в VBA
    #37055446
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Van-Gogпомогите решитьпомочь? или прогу за вас написать?
...
Рейтинг: 0 / 0
Массивы в VBA
    #37055513
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Van-GogЗаписать элементы массива X=(x1,x2,…, xn) в обратном порядке в массив Y=(y1,y2,…, yn).
Впрочем, я сегодня добрый, вот решение первой части. Думаю, что вторая часть не вызовет затруднений.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
Private Sub Command1_Click()

Dim x() As Integer, y() As Integer
Dim s As String, n As Integer, i As Integer
Dim Ex As Object, ExWB As Object, ExWS As Object

'инициализация
On Error Resume Next
Do
  Do
    s = InputBox("Введите размер массива")
    If s = "" Then Exit Sub
    n = CInt(s)
    If Err =  0  Then Exit Do
    MsgBox "Введенное выражение должно быть целым числом"
    Err.Clear
  Loop
  If n >  0  Then Exit Do
  MsgBox "Размер должен быть больше нуля"
Loop
On Error GoTo  0 
ReDim x( 1  To n)
ReDim y( 1  To n)

'заполнение начального массива случайными числами
For i =  1  To n
  x(i) = Fix(Rnd( 1 ) *  1000 )
  Debug.Print CStr(i), CStr(x(i))
Next

'собственно, решение задачи
On Error GoTo ExErr
Set Ex = CreateObject("Excel.Application")
Set ExWB = Ex.WorkBooks.Add
Set ExWS = ExWB.WorkSheets( 1 )
For i =  1  To n
  ExWS.Cells(i,  1 ) = i
  ExWS.Cells(i,  2 ) = x(i)
Next
ExWS.Range(ExWS.Cells( 1 ,  1 ), ExWS.Cells(n,  2 )).Sort Key1:=ExWS.Cells( 1 ,  1 ), Order1:= 2 , Header:= 2 

For i =  1  To n
  y(i) = ExWS.Cells(i,  2 )
  Debug.Print CStr(i), CStr(y(i))
Next
ExWB.Close False
Set Ex = Nothing

Exit Sub


ExErr:
MsgBox "Ошибка: "+Err.Description, vbCritical, "Не судьба"
Set Ex = Nothing

End Sub
...
Рейтинг: 0 / 0
Массивы в VBA
    #37057822
Van-Gog
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Мне б попроше , но всеравно спасибо
...
Рейтинг: 0 / 0
Массивы в VBA
    #37058028
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Van-GogМне б попроше , но всеравно спасибо
я могу только еще посложнее...
попроще каждый дурак может - чего там всего один цикл с тремя строчками на каждое задание...
...
Рейтинг: 0 / 0
Массивы в VBA
    #37058594
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Приветствую. Без комментариев.
Далее функция по созданию массива
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
Function CreateArray(ByRef arrObj As Object, _
                ByVal arrName As String, _
                Optional ByVal Nrazmer As String = vbNullString) As Boolean
Dim arrn, i As Long, regs As Object, Response
Set regs = NewDict
'-------------------------------------------------------------------------------
'проверка существования массива
If arrObj.Exists(arrName) Then
    Response = MsgBox("Массив '" & arrName & "' уже существует. Заменить?", vbYesNo, "Вопрос")
    If Response = vbYes Then
        arrObj.Remove arrName
    Else
        MsgBox "Массив '" & arrName & "' не создан.": Exit Function
    End If
End If
'-------------------------------------------------------------------------------
'создание массива
arrObj.Add arrName, NewDict
arrObj(arrName).Add "Name", arrName
arrObj(arrName).Add "Razmer", NewDict
arrObj(arrName).Add "Values", NewDict
arrObj(arrName)("Razmer").Add "flag", True
arrObj(arrName)("Razmer").Add "N", Nothing
Nrazmer = Replace(Nrazmer, " ", vbNullString)
arrObj(arrName)("Razmer")("flag") = (Nrazmer <> vbNullString) 'False - нет ограничений по n-размерности массива
If arrObj(arrName)("Razmer")("flag") Then
    Set arrObj(arrName)("Razmer")("N") = NewDict
    arrn = Split(Nrazmer, ",")
    For i =  0  To UBound(arrn,  1 )
        CreateArray = False
        arrObj(arrName)("Razmer")("N").Add i, NewDict
        If preg_match(NewReg, "^(\d+)$", CStr(arrn(i)), regs) Then ' размерность типа - количество элеметнов X (от 0 до X-1)
            arrObj(arrName)("Razmer")("N")(i).Add "flag", True 'True - есть ограничения по количеству элементов массива
            arrObj(arrName)("Razmer")("N")(i).Add "from", CLng( 0 )
            arrObj(arrName)("Razmer")("N")(i).Add "to", CLng(regs( 1 )) -  1 
            CreateArray = True
        End If
        If preg_match(NewReg, "^(\d+)to(\d+)$", CStr(arrn(i)), regs) Then ' размерность типа - от Х до Y
            arrObj(arrName)("Razmer")("N")(i).Add "flag", True 'True - есть ограничения по количеству элементов массива
            If CLng(regs( 0 )) <= CLng(regs( 1 )) Then
                arrObj(arrName)("Razmer")("N")(i).Add "from", CLng(regs( 1 ))
                arrObj(arrName)("Razmer")("N")(i).Add "to", CLng(regs( 2 ))
                CreateArray = True
            Else
                CreateArray = False
            End If
        End If
        If CStr(arrn(i)) = vbNullString Then ' массив безразмерен
            arrObj(arrName)("Razmer")("N")(i).Add "flag", False  'False - нет ограничений по количеству элементов массива
            CreateArray = True
        End If
        If Not CreateArray Then
            MsgBox "Неправильно задана размерность '" & CStr(arrn(i)) & "', массив '" & arrName & "' не создан."
            arrObj.Remove arrName
            Exit Function
        End If
    Next
End If
End Function
Далее свойство для записи элементов массива
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
Property Let ValueArray(ByRef arrObj As Object, _
                ByVal arrName As String, _
                ByVal Nrazmer As String, _
                ByVal arrValue)
If Not arrObj.Exists(arrName) Then
    MsgBox "Массив '" & arrName & "' не существует."
    Exit Property
End If
Dim flag As Boolean
Nrazmer = Replace(Nrazmer, " ", vbNullString)
If arrObj(arrName)("Razmer")("flag") Then
    Dim arrn, N As Long, i As Long
    arrn = Split(Nrazmer, ",")
    N = CLng(UBound(arrn,  1 ) +  1 ) 'размерность, указанная при вводе
    If CLng(arrObj(arrName)("Razmer")("N").Count) = N Then ' сверка размерностей
        For i =  0  To UBound(arrn,  1 )
            If arrObj(arrName)("Razmer")("N")(i)("flag") Then
                N = CLng(arrn(i))
                flag = (arrObj(arrName)("Razmer")("N")(i)("from") <= N And N <= arrObj(arrName)("Razmer")("N")(i)("to"))
                If Not flag Then MsgBox MsgBox "Массив '" & arrName & "': при записи неправильно указан индекс массива."
            Else
                flag = True
            End If
        Next
    Else
        MsgBox "Массив '" & arrName & "': при записи неправильно указана размерность массива"
        flag = False
    End If
Else
    flag = True
End If
'-----------------------------------------------------------
If flag Then
    If arrObj(arrName)("Values").Exists(Nrazmer) Then
        arrObj(arrName)("Values")(Nrazmer) = arrValue
    Else
        arrObj(arrName)("Values").Add Nrazmer, arrValue
    End If
End If
End Property
Свойство для "чтения" полностью приводить не буду, похоже на свойства для "записи", за исключением последнего:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
'-----------------------------------------------------------
If flag Then
    If arrObj(arrName)("Values").Exists(Nrazmer) Then
        ValueArray = arrObj(arrName)("Values")(Nrazmer)
    Else
        MsgBox "Значение отсутствует"
        ValueArray = Empty
    End If
End If
Некоторые вспомогательные функции, исползуемые выше
Код: plaintext
1.
2.
3.
Function NewDict() As Object
Set NewDict = CreateObject("Scripting.Dictionary")
End Function
Код: plaintext
1.
2.
3.
4.
5.
6.
Function NewReg() As Object
Set NewReg = CreateObject("VBScript.RegExp")
NewReg.Global = True
NewReg.IgnoreCase = True
NewReg.MultiLine = True
End Function
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Public Function preg_match(ByRef reg As Object, ByVal match As String, ByVal str As String, Optional ByRef regs As Object = Nothing) As Boolean
Dim i As Integer
reg.Pattern = match
If reg.Test(str) Then
    preg_match = True
    If Not regs Is Nothing Then
        regs.RemoveAll
        With reg.Execute(str).Item( 0 ).Submatches
            For i =  0  To .Count -  1 
                regs.Add i +  1 , Trim(.Item(i))
            Next
        End With
    End If
Else
    preg_match = False
End If
End Function
Пример использования
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Set arrGlobal = NewDict

CreateArray arrGlobal, "arrTest0"
CreateArray arrGlobal, "arrTest1", "10"
CreateArray arrGlobal, "arrTest2", "10, 20"
CreateArray arrGlobal, "arrTest3", "0 To 10"
CreateArray arrGlobal, "arrTest4", "10, 1 To 10"
CreateArray arrGlobal, "arrTest5", "1 To 10, 10 To 100"
CreateArray arrGlobal, "arrTest6", "5, 1 To 10, 10 To 100, 1000"

ValueArray(arrGlobal, "arrTest0", "0") =  1 
ValueArray(arrGlobal, "arrTest0", "0, 1") =  3 
ValueArray(arrGlobal, "arrTest1", "1") =  2 
ValueArray(arrGlobal, "arrTest2", "1, 2") =  3 
ValueArray(arrGlobal, "arrTest3", "3") =  4 
ValueArray(arrGlobal, "arrTest4", "5, 6") =  4 
ValueArray(arrGlobal, "arrTest6", "3, 5, 20, 300") =  4 

MsgBox ValueArray(arrGlobal, "arrTest6", "3, 5, 20, 300")
...
Рейтинг: 0 / 0
Массивы в VBA
    #37058680
Фотография Antonariy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Для чего эта жуть написана? Ничего, что такие "массивы" будут работать в разы медленнее обычных?
...
Рейтинг: 0 / 0
Массивы в VBA
    #37058714
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Тут как раз с полгодика назад поднимался вопрос о работе с массивами произвольной размерности....
...
Рейтинг: 0 / 0
Массивы в VBA
    #37058833
Фотография Antonariy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Похоже я не видел этот вопрос. Не представляю себе практическую задачу, где требовался бы такой массив.
...
Рейтинг: 0 / 0
69 сообщений из 69, показаны все 3 страниц
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Массивы в VBA
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]