Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Как назначить размерность Variant-переменной, если неизвестно кол-во данных?

248
26 апреля 2011 года
Dmitry2064
590 / / 06.12.2006
Сначала просто в переменную записал такой массив
myVBAmoduls = Array("a", "b", "c")
Потом понял, что этот список может периодчески пополняться и проще было бы список держать не в коде функции, а в стороннем файле, куда при необходиости можно было бы просто дописывать нужные данные. А процедурка их бы оттуда выуживала.
Т.е. надо в функцию загнать список строковых данных из текстфайла.
Код:
Function myVBAmoduls()
Dim myVBAmod As Variant
Open "d:\myModuls" For Input As #1
k = 0
Do While Not EOF(1)
    Line Input #1, TextLine
    k = k + 1
Loop
Close #1
ReDim myVBAmod(k)
''''т.е. приходится сначала считать кол-во строк, а потом по их колву выделять размер перменной

''''' теперь заносим в переменную данные
Open "d:\myModuls" For Input As #1
k = 0
Do While Not EOF(1)
        Line Input #1, TextLine
k = k + 1
myVBAmod(k) = TextLine
Loop
            Close #1
myVBAmoduls = myVBAmod(k)
End Function


Можно ли избежать такого двойного "прогона"? (чувствую, что тут еще что-то лишнее, и кроме того первая ячейка получается пустой - нельзя ли не с 1 заполняться, а с 0?).

p.s. Исходная функция выглядела так:
 
Код:
Function myVBAmoduls()
myVBAmoduls = Array("a", "b", "c")
End Function

Она нужна, что бы из разных процедур обращаться к этому списку (т.е., если список меняется, то чтобы испрвлять его надо было бы только в одном месте). А потом вот захотел исправлять вообще текстовом файле. Поэтому и возник вопрос с размером массивной перменной при неизвестном кол-ве элементов.
275
27 апреля 2011 года
pashulka
985 / / 19.09.2004
Если нужно получить все строки (а не последнюю, как в вышеопубликованной процедуре), то начиная с Office2000 можно использовать такой вариант (текстовый файл, естественно, должен существовать) :

Код:
Private Function getArrayTextFile(iFileName$) 'As Variant
    Open iFileName$ For Input As #1
         getArrayTextFile = Split(Input(LOF(1), #1), vbCrLf)
    Close #1
End Function

Private Sub Test()
   
    iArray = getArrayTextFile("C:\Modules\StModule.bas")
    '
End Sub



Если же нужен именно цикл, то использовав ReDim Preserve можно действительно обойтись только одним "прогоном"
248
27 апреля 2011 года
Dmitry2064
590 / / 06.12.2006
"iArray = getArrayTextFile("d:\My Dropbox\CPK\Bas_&_dots\myModuls")"
Это мощно. Ррраз и все! Спасибо.

А в учебных целях по Redim можно вопрос?
Код:
Function myVBAmoduls()
Dim k As Integer
Dim myVBAmods() As String '(или Variant - все равно остановка)
ReDim Preserve myVBAmods(k)

Open "с:\myModuls" For Input As #1
    k = 0
    Do While Not EOF(1)
        Line Input #1, TextLine    ' Read line into variable.
        myVBAmods(k) = TextLine
        k = k + 1
    Loop
Close #1
myVBAmoduls = myVBAmods
End Function


При k= 1 пишет Outofrange. Т.е. как задать приращение на одну ячеку размерности массиву? или я что-то не так записываю?
275
27 апреля 2011 года
pashulka
985 / / 19.09.2004
 
Код:
...
Line Input #1, TextLine    ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...
405
28 апреля 2011 года
Dmitrii
554 / / 16.12.2004
Цитата: Dmitry2064
... в учебных целях по Redim...

В учебных целях предлагаю посмотреть такой пример. Думаю, будет интересно.

Код:
Sub Example()
Dim arrTemp
arrTemp = Array()
MsgBox LBound(arrTemp) & " : " & UBound(arrTemp)
On Error Resume Next
arrTemp(LBound(arrTemp)) = 100
If Err.Number <> 0 Then
    MsgBox Err.Description
    Err.Clear
Else
    MsgBox arrTemp(LBound(arrTemp))
End If
On Error GoTo 0
For i = 0 To 9
    ReDim Preserve arrTemp(UBound(arrTemp) + 1)
    arrTemp(UBound(arrTemp)) = i + 10
Next
MsgBox LBound(arrTemp) & " : " & UBound(arrTemp) & vbNewLine & _
        arrTemp(LBound(arrTemp)) & " : " & arrTemp(UBound(arrTemp))
Erase arrTemp
On Error Resume Next
MsgBox LBound(arrTemp) & " : " & UBound(arrTemp)
If Err.Number <> 0 Then
    MsgBox Err.Description
    Err.Clear
End If
End Sub
248
29 апреля 2011 года
Dmitry2064
590 / / 06.12.2006
Цитата: pashulka
 
Код:
...
Line Input #1, TextLine    ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...



Все работает, спасибо. (но с предыдущим, однострочным вариантом веселее :) ).

248
29 апреля 2011 года
Dmitry2064
590 / / 06.12.2006
Цитата: Dmitrii
В учебных целях предлагаю посмотреть такой пример. Думаю, будет интересно.
 
Код:
Sub Example()
...
End Sub



Сразу не разобраться, требуется времечко. Спасибо.

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог