VBA宏运行时错误9:下标超出范围 - 如果语句

时间:2012-09-25 19:03:28

标签: vba excel-vba excel

我正在开展一个需要使用GA的项目。我的代码中遇到以下错误。

以下代码用于执行GA的交叉。大多数变量都是通过userform输入的。 *请注意,此代码可能包含更多错误。

我的变数:

Dim FitValarr() As Long
Dim fitsmall As Long
Dim Poparr() As Integer
Dim PopSize As Long
Dim Cross_Prob As Double
Dim overallRandom As Single
Dim FitValarr() As Long
Dim fitsmall As Long
Dim newChildarr() As Integer
Dim newChildfit As Integer
Dim child1() As Integer
Dim child2() As Integer
Dim fitvalchild1 As Integer
Dim fitvalchild2 As Integer
Dim crossoverpos As Integer
Dim chromosomerandom As Integer
Dim fitbig As Integer
Dim i As Long, j As Long, counter As Long
Dim Chromolength As Integer

代码:

Chromolength = varchromolength * aVariables  'usual value is around 30 = (10*3)
ReDim Poparr(1 To PopSize, 1 To Chromolength)
ReDim FitValarr(1 To PopSize)                 'popsize is around 10 -50
ReDim newChildarr(1 To Chromolength) As Integer
ReDim child1(1 To Chromolength) As Integer
ReDim child2(1 To Chromolength) As Integer

 'chosing two random chromosomes
Dim rand1 As Integer
Dim rand2 As Integer

rand1 = Int(Rnd * PopSize)               'generate random value between 1-50
rand2 = Int(Rnd * PopSize)               'same as above

Do While rand1 = rand2
       rand2 = Int(Rnd * PopSize)        'checking that the two random values isn't the same
Loop


If overallRandom < Cross_Prob Then                  

    If FitValarr(rand1) > FitValarr(rand2) Then    
        Do While rand1 = rand2
        rand2 = Int(Rnd * PopSize)
        Loop
    Else
        Do While rand1 = rand2                     
        rand1 = Int(Rnd * PopSize)
        Loop
    End If

    crossoverpos = Int(Rnd * Chromolength)
    Do While crossoverpos < 1 & crossoverpos > Chromolength
    Loop

    'do crossover and assign it to child# array
    For i = 1 To crossoverpos                                   
        child1(i) = Poparr(rand1, i)                            
        child2(i) = Poparr(rand2, i)                            
    Next i

    For i = crossoverpos To Chromolength
        child1(i) = Poparr(rand2, i)                            
        child2(i) = Poparr(rand1, i)                            
    Next i

    'fitness of the two offsprings
    For i = 1 To Chromolength                                  
        counter = Chromolength

        Do While counter > 0
            fitvalchild1 = fitvalchild1 + child1(counter) * 2 ^ (i - 1)
            fitvalchild2 = fitvalchild2 + child2(counter) * 2 ^ (i - 1)
            counter = counter - 1
        Loop
    Next i

    If fitvalchild1 > fitvalchild2 Then                        
        newChildfit = fitvalchild1                             
        For i = 1 To Chromolength
        newChildarr(i) = child1(i)                             
        Next i

    Else                                                       
        newChildfit = fitvalchild2                             
        For i = 1 To Chromolength
        newChildarr(i) = child2(i)                             
        Next i

    End If

Else                                                            
    newChildfit = FitValarr(rand1)                              
    For i = 1 To Chromolength
        newChildarr(i) = Poparr(rand1, i)                       
    Next i

End If 'end crossover

错误在交叉码中:

 If FitValarr(rand1) > FitValarr(rand2) Then 

我为长代码道歉。我对VBA来说相当新,但还是有点蠢蠢欲动。

0 个答案:

没有答案