excel宏中动态数组的应用和求动态数组最小值

代码如下:

定义类型:

Public Type hhh
    line As Integer
    bz As Double
End Type

定义求行数的函数:
Public Function wwrows(str)
   Dim flag As Boolean
   Dim i As Integer
   i = 5
   flag = True
   rowcount = 0
   While flag
       If Sheets(str).Cells(i, 1) = "" Then
          flag = False
       End If
       i = i + 1
       rowcount = rowcount + 1
   Wend
   wwrows = rowcount
End Function


数组的使用:

Public Sub AddPrice()
    Dim count1, count2, ArrayCount As Integer
    Dim flag As Boolean
    Dim rq As Date
    Dim MyArray() As hhh
    For dd = 1 To 20
        Select Case dd
           Case 1
              rq = #5/1/2003#
           Case 2
              rq = #6/1/2003#
           Case 3
              rq = #7/1/2003#
           Case 4
              rq = #8/1/2003#
           Case 5
              rq = #9/1/2003#
           Case 6
              rq = #10/1/2003#
           Case 7
              rq = #11/1/2003#
           Case 8
              rq = #12/1/2003#
           Case 9
              rq = #1/1/2004#
           Case 10
              rq = #2/1/2004#
           Case 11
              rq = #3/1/2004#
           Case 12
              rq = #4/1/2004#
           Case 13
              rq = #5/1/2004#
           Case 14
              rq = #6/1/2004#
           Case 15
              rq = #7/1/2004#
           Case 16
              rq = #8/1/2004#
           Case 17
              rq = #9/1/2004#
           Case 18
              rq = #10/1/2004#
           Case 19
              rq = #11/1/2004#
           Case 20
              rq = #12/1/2004#
         End Select
        
         count1 = wwrows(dd)
         
         For i = 5 To count1
             If Sheets(dd).Cells(i, 9) = 0 And Sheets(dd).Cells(i, 12) = 0 Then
                 Sheets(dd).Cells(i, 7) = Sheets(dd).Cells(i, 4)
             End If
             If Sheets(dd).Cells(i, 12) = 0 And Sheets(dd).Cells(i, 3) = 0 Then
                 ArrayCount = 1

'vb中动态数组必须首先定义初始大小,注意redim会清空数组
                 ReDim MyArray(200)
                  flag = False

                  For j = 2 To 1067
                      If Sheets("sheet1").Cells(j, 1) = Sheets(dd).Cells(i, 1) Then
                          MyArray(ArrayCount).line = j
                          If rq >= CDate(Sheets("sheet1").Cells(i, 6)) Then
                              MyArray(ArrayCount).bz = rq - CDate(Sheets("sheet1").Cells(i, 6))
                          Else
                              MyArray(ArrayCount).bz = CDate(Sheets("sheet1").Cells(i, 6)) - rq
                          End If
                          ArrayCount = ArrayCount + 1
                          flag = True
                      End If
                 Next j
                 If flag Then

'重新定义数组大小,但保留arraycount-1不清空
                     ReDim Preserve MyArray(ArrayCount - 1)


'lbound求数组下标,ubound求上标

                     a = LBound(MyArray) + 1
                     b = UBound(MyArray)


'lbound求数组下标,ubound求上标

                     a = LBound(MyArray) + 1
                     b = UBound(MyArray)


                     Min = 1

'此循环求数组中最小值
                     For iii = a To b
                       If MyArray(iii).bz < MyArray(Min).bz Then
                          Min = iii
                       End If
                    Next iii
                    hang = MyArray(Min).line
                    
                    Sheets(dd).Cells(i, 10) = Sheets(dd).Cells(i, 9) * Sheets("sheet1").Cells(hang, 3)
                    Sheets(dd).Cells(i, 7) = Sheets(dd).Cells(i, 6) * Sheets("sheet1").Cells(hang, 3)
                 Else
                    Sheets(dd).Cells(i, 17) = "无命中记录"
                 End If
             End If
         Next i
    Next dd
End Sub