Excel VBA 코드를 더 효율적으로 만들고 시간을 단축하는 방법

Question

다음 코드는 다음과 같습니다. 나는 그것을 향상시킬 수있는 방법에 대한 조언과 제안을 원한다.

는 동작

1) 시차 촬영 2) 수

추정 코드의 정수 모든 변수가 매우 클 수 - 계산 예 각 dim as Long 및 코드> 0

목적인 변수 i에 저장된 수학 질문 (https://math.stackexchange.com/questions/2093497/finding-number-of-coprime-tuples-from-1-to-n/2094773)에 대한 솔루션의 튜플 (a, b, c, d) 수를 각각의 가능한 튜플 (a, b, c, d)을 Array_abcd()에 저장합니다.

** 특히 가장 느린 부분은 'Calculate tuples for F(i,j)=1 stored in Array_u_Fij() 아래의 코드 인 것 같습니다. Big-O n^5가 될 시간 복잡도를 계산합니다. ** - 이제는 도움을 요청하는 곳입니다.

기능 모듈로 :

는

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

Modulo = x * y mod p 

End Function 

홈페이지 하위 :

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 배열.

코드는 기본적으로 열 1과 2의 셀에서 반복하여 .Value을 가져옵니다. 이처럼 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 

후 더 이상하지만 col1Values(m, 1)sht2.Cells(m, 1).Value을 사용하지에에서

. (여기에서 Excel이 반환하는 배열은 2 차원 배열이므로 첫 번째 인덱스는 행이고 두 번째 열은 2 차원 배열입니다.)

Answer 2

또한이 작업을 수행하는 동안 계산 시작과 화면 갱신을 비활성화 할 수 있습니다. 코드 :

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

그리고 마지막에

이 정상으로 되돌릴 수는 :

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

매크로 충돌에주의하십시오. 충돌이 일어 났을 때 그 변수를 정상 변수로 되 돌리는 것을 잊지 마십시오.