функция VBA - need help!!!

mar-pavel
Дата: 19.09.2005 17:46:36
В Accesse в коде делаю перебор Ip адресов по маске, т.е. вводится маска ip адреса , например 123.123.123.??? , на основании которой создаётся массив адресов. Проблема в том что при переборе большого диапазона Access виснет. Это можно как нибудь обойти?

Код:
Function GetDataFromTripleIP(TripleIP As String) As Variant
Dim ab As Long, h As Variant, i As Long, j As Long, z As Long, z1 As Long, s As String, d As String, f As Variant, g As Variant, k As Variant
s = TripleIP
ReDim f(0) As Variant
ReDim g(0) As Variant
ReDim k(0) As Variant
f(0) = s
z1 = 0
While z1 <= UBound(f)
Form_Info_form.Repaint
j = 1
For j = 1 To Len(f(z1))
  If Mid(f(z1), j, 1) = "?" Then
   If (j Mod 4) = 1 Then z = 2
   If ((j Mod 4) = 2) Then
   If (Mid(f(z1), j - 1, 1) = "0") Then z = 9
   If (Mid(f(z1), j - 1, 1) = "1") Then z = 9
   If (Mid(f(z1), j - 1, 1) = "2") Then z = 2
   End If
   If ((j Mod 4) = 3) Then
   If (Mid(f(z1), j - 1, 1) = "0") Then z = 9
   If (Mid(f(z1), j - 1, 1) = "1") Then z = 9
   If (Mid(f(z1), j - 1, 1) = "2") And (Mid(f(z1), j - 2, 1) = "2") Then z = 4
   If (Mid(f(z1), j - 1, 1) = "2") And (Mid(f(z1), j - 2, 1) = "0") Xor (Mid(f(z1), j - 2, 1) = "1") Then z = 9
   End If
    ReDim g(z) As Variant
     For i = 0 To z
         If (j <> 1) Or (j <> Len(f(z1))) Then d = Mid(f(z1), 1, j - 1) & i & Mid(f(z1), j + 1, Len(f(z1)) - j)
         If j = 1 Then d = i & Mid(f(z1), j + 1, Len(f(z1)) - j)
         If j = Len(f(z1)) Then d = Mid(f(z1), 1, j - 1) & i
        g(i) = d
     Next i
  ReDim k(UBound(g) + UBound(f)) As Variant
  h = 0
  For ab = 0 To UBound(f)
   If ab = z1 Then
     For h = 0 To UBound(g)
       k(ab + h) = g(h)
     Next h
     h = h - 1
   End If
   If ab <> z1 Then k(ab + h) = f(ab)
  Next ab
  f = k
  End If
Next j
z1 = z1 + 1
Wend
GetDataFromTripleIP = f
End Function
Владимир Саныч
Дата: 19.09.2005 17:49:42
Именно виснет наглухо или просто долго считает?
mar-pavel
Дата: 19.09.2005 17:52:20
Через раз! если стоит 4-5 знаков маски то может и отвиснуть.
Но в любом случае сам Access подвисает, а это не есть гуд - пользователи нервные нынче
Гуест0000
Дата: 19.09.2005 22:05:56
фигасе кода наворотил
проще никак?
mar-pavel
Дата: 20.09.2005 09:01:32
Гуест0000
фигасе кода наворотил
проще никак?

Попробуй! Но в любом случае вопрос не по оптимизации кода
Allll
Дата: 20.09.2005 09:01:41
mar-pavel
Проблема в том что при переборе большого диапазона Access виснет.

"Большой диапазон" - это сколько?
Может, это не Access виснет, а что-то с Вашей программой не так?

При зависании, вы можете остановить эту программу нажатием Ctrl+Break?

Зачем вы делаете перерисовку формы Form_Info_form.Repaint? Тем более в цикле. Вы используете только массивы и никаким образом не обращаетесь к элементам формы. Зачем тогда нужна постоянная перерисовка?
Постоянные ReDim в цикле, тоже не ускоряют процесс.
mar-pavel
Дата: 20.09.2005 09:40:05
Allll

"Большой диапазон" - это сколько?

-несколько тысяч значений
Allll
Может, это не Access виснет, а что-то с Вашей программой не так?

При зависании, вы можете остановить эту программу нажатием Ctrl+Break?

Код вызывается по нажатию клавиши в форме. Соответственно и по Ctrl+Break он возвращает в VB

Allll
Зачем вы делаете перерисовку формы Form_Info_form.Repaint? Тем более в цикле. Вы используете только массивы и никаким образом не обращаетесь к элементам формы. Зачем тогда нужна постоянная перерисовка?
Постоянные ReDim в цикле, тоже не ускоряют процесс.

При выполнении кода появляется окно с сообщением о процессе - оно и обновляется - тем более что это не критично без него всё тоже самое.
А насчёт Redim интересно а как ещё можно объявить динамический массив?
kroost
Дата: 20.09.2005 10:25:13
Попробуйте поставить DoEvents, только не на каждой итерации, а, скажем, каждые 100 или 1000
Allll
Дата: 20.09.2005 10:41:35
mar-pavel
Соответственно и по Ctrl+Break он возвращает в VB

Значит Access не виснет, а просто ваша программа работает медленно!
Попробовал: при маске из из пяти ??.??? работает очень долго.

Можно:
1. подумать о другом алгоритме
2. подумать о числовых массивах. Если известна максимальная размерность массивов, то задать её по максимуму, а граничные значение хранить в переменных.
3. подумать, над постановкой задачи. Что вы потом делаете с этим массивом из 256, 512, 1024, ... строк? Может и не нужно заполнять полностью этот массив?
АлексейК
Дата: 20.09.2005 10:42:21
думаю что зависает из за большого расхода пямяти под массив
останов - прерывание начинает отнимать еще больше ресурсов

видимо список адресов сети более чем 255.255.0.0
врядли кому единовременно понадобится

лучше если надо такие объемы то формировать порциями по каждой сетке




Public Sub tst()
Dim NETMASK, NETADDRESS
Dim RES()
NETADDRESS = "123.123.0.0"
NETMASK = "255.255.0.0" '

Dim r, RT, I, J, K, L, ITOG As Variant
Dim It, Jt, Kt, N As Double
r = Split(NETMASK, ".", 4, vbTextCompare)
RT = Split(NETADDRESS, ".", 4, vbTextCompare)

ReDim RES(0 To IIf(r(0) = 255, 1, (255 - r(0))) * IIf(r(1) = 255, 1, (255 - r(1))) * IIf(r(2) = 255, 1, (255 - r(2))) * (254 - r(3)) - 1)


For I = r(0) To 255
    If r(0) = 255 Then It = RT(0) Else It = I - r(0)
    If It = 255 - r(0) Then GoTo NEXTI
    For J = r(1) To 255
         If r(1) = 255 Then Jt = RT(1) Else Jt = J - r(1)
         If Jt = 255 - r(1) Then GoTo NEXTJ
         For K = r(2) To 255
            If r(2) = 255 Then Kt = RT(2) Else Kt = K - r(2)
                If Kt = 255 - r(2) Then GoTo NEXTK
                For L = r(3) To 254
                    If L = 0 Then GoTo NXTL:
                    RES(N) = It & "." & Jt & "." & Kt & "." & L - r(3)
                    N = N + 1
NXTL:
                Next L

         DoEvents
NEXTK:
         Next K
NEXTJ:
    Next J
NEXTI:
Next I
Debug.Assert False

End Sub