VB.Net减缓了数组大小的增加

在我的数组处理密集型代码中，大约12000个条目（48000个条目在OK下运行）之后，处理条目的速度急剧降低，这与VB.Net无关，而与数组返回Excel后的处理方式有关，这真是太愚蠢了。他们最终得到了一个需要加载数组的函数，该函数有一个常量，这样它就可以在函数的后续运行中判断数组已加载。我忘了将该常量声明为公共布尔值，因此Excel只看到“null”而不是true/false

我要真诚地感谢你们所有人的帮助，尤其是TNTINN，让我思考（就像我从一开始就应该做的那样）时间安排的地点

---

从VBA到VB.Net的速度提高了7到10倍，对此进行的修复使我的速度进一步提高了7倍。

您能否切换到使用Try-Catch块的更现代的错误处理，并查看是否有任何错误被抛出？我想知道，以前删除了on错误，但没有任何效果。将编写正式的try-catch方法，并稍后报告。谢谢。如果没有输入数据和完整代码，很难发现任何具体问题。ReDim可能会变得昂贵。如果你一直测试11000个项目，它是否总是表现良好？12000之后，数据中是否有任何变化？输入数据是一张22列宽且长度可变的表。所有的都是十进制数，但都没什么区别。我不认为它会抛出异常，因为至少在VBA中，它经过了良好的测试，并且数据经过了检查/调整，以确保它的所有内容都是有效的和光明正大的。

<ComClass(clsAnnie.ClassId, clsAnnie.InterfaceId, clsAnnie.EventsId)>
Public Class clsAnnie
Public Const ClassId As String = "00E45698-E5C1-4F2C-8828-3F7404EF83A2"
Public Const InterfaceId As String = "2A1D9402-78DA-41F0-8DE3-1CD573AAF72C"
Public Const EventsId As String = "346E24CC-C9E1-4915-B254-BA80E6E310C4"

Public Sub New()
 MyBase.New
End Sub

'This routine is called repeatedly from the entry point 
'sub-routine Public Sub Train_NNT

Private Sub Calculate_NNT(ByVal Num_Layers%, ByVal Pattern%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByRef Hidden_Neuron_Value As Double(,,), ByRef Prediction_Output As Double(,), ByRef Pattern_Error As Double(), ByRef Training_Input As Double(,), ByRef Training_Output As Double(), ByRef Input_Weights As Double(,), ByRef Output_Weights As Double(,), ByRef Inter_Weights As Double(,,), ByVal drop_out As Boolean, ByRef doi As Integer(), ByRef dol As Integer(,), ByVal activation_function%)

On Error GoTo exity
Dim alldropped As Boolean, n#, a#, c#, m%, s%, Lay%, i%, j%

'The main code is removed to keep the post short, but all it does is mathematically
'loop through the arrays and undertake maths on the values before updating one 
'particular array (Training_Output) and passing that back to the main routine.  
'None of the other arrays or variables have their values changed.  
'Last few lines as follows for context as follows....

Prediction_Output(Pattern%, 1) = 0
For m% = 1 To Num_Hidden% : Prediction_Output(Pattern%, 1) = Prediction_Output(Pattern%, 1) + (Hidden_Neuron_Value(Pattern%, Num_Layers%, m%) * Output_Weights(m%, 1)) : Next
Pattern_Error(Pattern%) = Prediction_Output(Pattern%, 1) - Training_Output(Pattern%)
exity:
End Sub

'This is the main routine that is called from Excel VBA.  It's called only once.

Public Sub Train_NNT(ByRef doi As Integer(), ByRef dol As Integer(,), ByRef OF_Array As Double(,), ByRef Cyc%, ByRef Hidden_Neuron_Value As Double(,,), ByRef Pattern_Error As Double(), ByRef Inter_Weights As Double(,,), ByRef Prediction_Output As Double(,), ByRef Training_Input As Double(,), ByRef Training_Output As Double(), ByRef Training_Input_Test As Double(,), ByRef Training_Output_Test As Double(), ByRef Input_Weights As Double(,), ByRef Output_Weights As Double(,), ByVal activation_function%, ByVal Num_Patterns%, ByVal Cycles%, ByVal Num_Layers%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByVal Num_Patterns_Test%, ByVal Learn_Rate#, ByVal Maximum_Data_Value As Double, ByVal Minimum_Data_Value As Double, ByVal DOLLR As Boolean, ByVal Overfitting_CF As Boolean, ByVal Lregression As Boolean, ByVal cosine_annealing As Boolean, ByVal ADAMW As Boolean, ByVal Nesterov As Boolean, ByVal drop_out As Boolean, ByVal random_sampling As Boolean, ByVal animations As Boolean)

On Error GoTo exit_train

'These declarations shown in case it's something to do with garbage collection?

Dim Min_CET#, Best_Error#, Best_Error_Test#, Current_Error#, Current_Error_Test#, Learn_Rate_Original#, Learn_Rate_Min#, Learn_Mult#, Learn_Rate_Const#, lamda#
Dim beta_1#, beta_1_1#, beta_2#, beta_2_2#, mom_1#, mom_2#, mom_3#, damp#, cos_tmp#, beta_1_2#, tmp#, n#, P_Pat_Error#, Learn_Rate_Inv#, beta_sqr#, epsilon#
Dim Pat_Error#, Pat_Error_M#, tmp_5#, dw#, derivative#, tmp_1#, MaDV#, MiDV#
Dim Picture_Count As Integer, Picture_VE As Integer
Dim error_counter%, Snaps%, Pattern%, i%, s%, m%, o%, Pat_Test%, Pat%, q%, Lay%, j%
Dim Error_Array(0 To 100) As Double, HNV(0 To Num_Layers%, 0 To Num_Hidden%) As Double, neuron_error(0 To Num_Layers%, 0 To Num_Hidden%) As Double

Dim vdw_o() As Double, sdw_o() As Double, vdw_i() As Double, sdw_i() As Double, Output_Momentum() As Double, Input_Momentum(,) As Double, Inter_Momentum(,,) As Double

ReDim vdw_o(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), sdw_o(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), vdw_i(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), sdw_i(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2))
ReDim Output_Momentum(0 To Num_Hidden%), Input_Momentum(0 To (Num_Inputs% + 1), 0 To Num_Hidden%), Inter_Momentum(0 To Num_Layers%, 0 To Num_Hidden%, 0 To Num_Hidden%)

'Here we enter a loop which processes the arrays

For Cyc% = 1 To Cycles%

'Code removed here as just altering some variables and performing maths on them.

'I call the routine above...

Call Calculate_NNT(Num_Layers%, Pattern%, Num_Hidden%, Num_Inputs%, Hidden_Neuron_Value, Prediction_Output, Pattern_Error, Training_Input, Training_Output, Input_Weights, Output_Weights, Inter_Weights, drop_out, doi, dol, activation_function%)

'Lot of code removed, uses the answer from the routine above to process and alter 
'a number of arrays.  The array passed back (or is used) is 
'Training_Output

'Every 50 cycles I need to call a function called ANNIE_TEST 
'which independently verifies whether the maths hasn't exceeded 
'certain thresholds, which if it has then stops the whole process 
'and hands back to Excel.

'Code below just for context
If Cyc% Mod 50 = 0 Then
If Overfitting_CF Then

Current_Error_Test# = 0
For Pat_Test% = 1 To Num_Patterns_Test% : Current_Error_Test# = Current_Error_Test# + (ANNIE_TEST(Pat_Test%, Num_Hidden%, Num_Inputs%, Num_Layers%, activation_function%, Output_Weights, Inter_Weights, Training_Input_Test, Input_Weights, HNV) - Training_Output_Test(Pat_Test%)) ^ 2 : Next

Current_Error_Test# = Math.Sqrt(Current_Error_Test# / Num_Patterns_Test%)
OF_Array(q%, 1) = Cyc% : OF_Array(q%, 2) = Current_Error_Test# : q% = q% + 1

Min_CET# = 0
For o% = 1 To error_counter% : Min_CET# = Min_CET# + Error_Array(o%) : Next
Min_CET# = Min_CET# / error_counter%

If Current_Error_Test# <= Min_CET# Then
For o% = error_counter% To 2 Step -1 : Error_Array(o%) = Error_Array(o% - 1) : Next

Error_Array(1) = Current_Error_Test#
Else
Exit For
End If

End If
End If
Next 'cycles
exit_train:
End Sub

Private Function ANNIE_TEST(ByVal Pat_Test%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByVal Num_Layers%, ByVal activation_function%, ByRef Output_Weights As Double(,), ByRef Inter_Weights As Double(,,), ByRef Training_Input_Test As Double(,), ByRef Input_Weights As Double(,), ByRef HNV As Double(,))

Dim m%, j%, s%, Lay%
Dim a#, c#, n#, prediction#

'Code removed as it just loops through arrays and undertakes maths on them.
'None of the arrays have values altered, just used

prediction# = 0
For j% = 1 To Num_Hidden% : prediction# = prediction# + (HNV(Num_Layers%, j%) * Output_Weights(j%, 1)) : Next
ANNIE_TEST = prediction#
End Function

End Class