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
Как назначить размерность Variant-переменной, если неизвестно кол-во данных?
myVBAmoduls = Array("a", "b", "c")
Потом понял, что этот список может периодчески пополняться и проще было бы список держать не в коде функции, а в стороннем файле, куда при необходиости можно было бы просто дописывать нужные данные. А процедурка их бы оттуда выуживала.
Т.е. надо в функцию загнать список строковых данных из текстфайла.
Код:
Можно ли избежать такого двойного "прогона"? (чувствую, что тут еще что-то лишнее, и кроме того первая ячейка получается пустой - нельзя ли не с 1 заполняться, а с 0?).
p.s. Исходная функция выглядела так:
Код:
Function myVBAmoduls()
myVBAmoduls = Array("a", "b", "c")
End Function
myVBAmoduls = Array("a", "b", "c")
End Function
Она нужна, что бы из разных процедур обращаться к этому списку (т.е., если список меняется, то чтобы испрвлять его надо было бы только в одном месте). А потом вот захотел исправлять вообще текстовом файле. Поэтому и возник вопрос с размером массивной перменной при неизвестном кол-ве элементов.
Код:
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
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 можно действительно обойтись только одним "прогоном"
Это мощно. Ррраз и все! Спасибо.
А в учебных целях по 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
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. Т.е. как задать приращение на одну ячеку размерности массиву? или я что-то не так записываю?
Код:
...
Line Input #1, TextLine ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...
Line Input #1, TextLine ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...
Цитата: 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
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
Цитата: pashulka
Код:
...
Line Input #1, TextLine ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...
Line Input #1, TextLine ' Read line into variable.
myVBAmods(k) = TextLine
k = k + 1
ReDim Preserve myVBAmods(k)
...
Все работает, спасибо. (но с предыдущим, однострочным вариантом веселее :) ).
Цитата: Dmitrii
В учебных целях предлагаю посмотреть такой пример. Думаю, будет интересно.
Код:
Sub Example()
...
End Sub
...
End Sub
Сразу не разобраться, требуется времечко. Спасибо.