Excel VBA Как сделать код более эффективным и взять меньше времени

Question

У меня следующий код ниже. Я хотел бы получить советы и предложения о том, как его можно улучшить/переписать, чтобы свести к минимуму;

1) Время, затраченное 2) Количество операций

все переменные предполагают, что являются целым числом в коде может быть очень большим - например, каждый dim as Long, а> 0.

Назначение кода, является подсчет количество кортежей (a, b, c, d) для решения математического вопроса (https://math.stackexchange.com/questions/2093497/finding-number-of-coprime-tuples-from-1-to-n/2094773), хранящегося в переменной i, и хранения каждого возможного набора (a, b, c, d) в Array_abcd().

** В частности, самая медленная часть представляется кодом под 'Calculate tuples for F(i,j)=1 stored in Array_u_Fij() - где я рассчитываю сложность времени для Big-O n^5. ** - Сейчас я обращаюсь за помощью.

Функция Modulo:

Function Modulo(x as long, y as long, p as long) as Long 

Modulo = x * y mod p 

End Function 

Главная Sub:

Sub Number_tuples() 

'This is limited by the number of rows and column an 
'.xlsm file can have. 
Application.screenupdating=false 
Application.displayalerts=false 
Application.calculation=xlcalculationmanual 

Prime1=599 
Prime2=601 
p=Prime1 * Prime2 

'Set up sheet 1 
... 
'Set up sheet 2 
... 

'Declare Array_Ints() 
Redim Array_ints(4) 

'Store list of integers to be given in question 
'This can be any list of integers 
Array_ints(0)=1 
Array_ints(1)=10 
Array_ints(2)=100 
Array_ints(3)=1000 

'Calculate N 
N=Ubound(Array_ints) 

'Declare array Array_nu_Fij() 
Redim Array_nu_Fij(N,N,2) 

'Calculate all non-unique Fij and store results in Array_nu_Fij(), and put matrix of nu_Fij values in sheet 1 
... 
Array_nu_Fij(i,j,0) = Modulo(a,b,p) 
Array_nu_Fij(i,j,1) = Cstr(a) & "," & Cstr(b) 
sht1.cells(i+2, j+1).value=Array_nu_Fij(i,j,0) 
... 

'Declare Array_u_Fij() 
ReDim Array_Fij(N*N,3) 

'Calculate all unique Fij 
'Store uFij value in Array_u_Fij(o,0), and a_b in Array(o,1) 
'Put a_b value in worksheet 2 
... 

'Put freq from worksheet 2 in Array_u_Fij() 
... 


'Calculate size of 1st col of Array_u_Fij() 
lastrow_new_sht2= sht2.Cells(sht2.Rows.Count, "A"). End(xlUp).Row 
startrow_sht2 = 3 
size_u_Fij_1col = lastrow_new_sht2 - startrow_sht2 + 1 

'Declare Array_abcd() 
ReDim Array_abcd(N*N) 

'Calculate tuples for F(i,j)=1 stored in Array_u_Fij() 
i=0 
For m = 0 to size_u_Fij_1col - 1 
    'Store current u_Fij and freq being considered 
    u_fij_1= Array_u_Fij(m,0) 
    Freq = Array_u_Fij(m,1) 
    a_b = Array_u_Fij(m,2) 
    c_d = "" 
     While freq > 1 
      'First compare u_Fij_1 with current u_Fij_1 
      For freq_gt_1 = 2 to freq 
       'Check if u_Fij_1 = 1 
       If u_fij_1 = 1 then 
        dblGCD = 1 
        i = i +1 
        Array_abcd(m)= Array_abcd(m) & "||" & a_b 
       Else 
        'GCD of u_Fij_1 with other u_Fij_1 
        dblGCD = u_Fij_1 
        If dblGCD = 1 then 
         i = i + 1 
         Array_abcd(m)= Array_abcd(m) & "||" & a_b 
        Else 
        End if 
       End if 
      Next freq_gt_1 

      '2nd compare u_Fij_1 with u_Fij_2<>u_Fij_1 
      For q = 1 to lastrow_sht2 
       If m+q >= size_u_Fij_1col then 
        'Array_u_Fij(m+q) doesn't exist 
        'Hence no need to check 
       Else 
        u_Fij_2 = Array_u_Fij(m+q+1,0) 
        freq_other = Array_u_Fij(m+q+1,1) 
        c_d = Array_u_Fij(m+q+1,2) 
        'Only consider freq_other > 0 
        While freq_other > 0 
         if u_Fij_1 =1 then 
          'GCD is 1 
          dblGCD = 1 
          Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d 
          i = i + 1 
         Elseif u_Fij_1 = u_Fij_2 then 
          dblGCD = u_Fij_1 
          If dblGCD = 1 then 
           i = i + 1 
           Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d         
          Else 
          End if 
         Elseif u_fij_2 = 1 then 
          dblGCD = 1 
          i = i +1 
          Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d 
         Else 
          dblGCD = Application.WorksheetFunction.GCD(u_Fij_1,u_Fij_2) 
          If dblGCD = 1 then 
           i = i + 1 
           Array_abcd(m)= Array_abcd(m) & "||" & a_b & "," & c_d         
          Else 
          End if 
        Else 
        End if 
        Freq_other = freq_other - 1 
       Wend 
      End if 
     Next q 
     Freq=freq - 1 
    Wend 

    While freq=1 
     'Compare a=u_Fij_1 with b=u_Fij_2<>1 
     For q = 0 To size_uFij_1col 
      'Check if m+q is equal to or larger than size of 
      'array 
      If m+q >= size_uFij_1col then 
       'Do nothing 
      Else 
       If u_fij_1 = 1 then 
        dblGCD = 1 
        Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d 
        i= i+1 
       Else 
        'u_Fij_1 <>1. Now need to consider freq of other u_Fij_2=b<>a 
        u_Fij_2 = Array_u_Fij(m+q+1,0) 
        freq_other=Array_uFij(m+q+1,1) 
        c_d=Array_uFij(m+q+1,2) 
        'Only consider freq_other > 0 
        While freq_other > 0 
         'Check if u_Fij_2 =1 
         If u_Fij_2 = 1 then 
          'GCD is 1 
          Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d 
          i = i + 1 
         Else 
          'Need to determine GCD 
          dblGCD = Application.WorksheetFunction.GCD(u_Fij_1,u_Fij_2) 
          If dblGCD = 1 then 
           I = I+ 1 
           Array_abcd(m)=Array_abcd(m) & "||" & a_b & "," & c_d 
          Else 
          End if    
         End if 
         Freq_other = Freq_other - 1 
        Wend 
        End if 
      End if 
     Next q 
     Freq=freq - 1 
    Wend 
Next m 

Application.screenupdating=true 
Application.displayalerts=true 
Application.calculation=xlcalculationautomatic 

End Sub 

Answer 1

Без точно зная ваши данные, и насколько она может быть, она может быть оптимизирована путем выборки всех данных, необходимых в один присест в Массивы VBA.

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

Вместо этого попробуйте получить данные в столбцах 1 и 2 только один раз и вместо этого работать с этими массивами. Как например .:

Dim col1Values As Variant 
col1Values = sht2.Range(sht2.Cells(1, 1), sht2.Cells(lastrow_sht2, 1)).Value 
Dim col2Values As Variant 
col2Values = sht2.Range(sht2.Cells(1, 2), sht2.Cells(lastrow_sht2, 2)).Value 

и с тех пор не использовать sht2.Cells(m, 1).Value больше, но col1Values(m, 1). (обратите внимание, что массивы Excel возвращаются сюда: 2-мерные массивы, где 1-й индекс - это строка и 2-й столбец.)

Answer 2

Кроме того, вы можете отключить вычисление и выключение экрана во время операции с этим в начале вашего код:

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

И в конце концов, вернуться к нормальной жизни:

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

Будьте осторожны с макро аварий. Не забывайте возвращать нормальные переменные, когда происходит авария.