如何从Excel VBA中的动态数组创建动态数组?

时间:2017-05-25 15:18:43

标签: arrays excel vba dynamic

我一直在寻找答案,但我找不到答案,如果已有答案,那么我道歉,如果你能引导我到正确的线程,我将不胜感激。

背景: 我正在操作大约500行和34列数据,这些数据适用于我们生产工厂中的所有订单。我们的系统提供了一个.dqy报告,我使用VBA对所有部门的所有数据进行排序/组织。我现在陷入困境的是调度/容量规划。

问题: 我有一个初始数组,它抓取.dqy报告,根据处理时间和交付日期添加它,然后将其分解为4个较小的数组。

其中一个较小的阵列根据其生产线再次分解为3个较小的阵列。然后,我为这些最小的阵列构建3个附带的阵列,并获取该阵列中的所有“唯一”批号。

这是我被困的地方: 这些批次编号和批次数每天都在变化,因此“唯一”批次数组是动态的,我想为每个“唯一”批次编号构建单独的数组(给定批次中有多个订单号)。

解决方案: 我只有2D阵列的经验,但3D阵列是一个选择吗? 我遇到的问题是尝试根据“独特”批次的动态数量来参数化新阵列的数量。

我将在下面发布我的一些代码,非常感谢任何帮助。一个确切的解决方案将是首选,但任何有关编码方法的帮助都会有所帮助。

谢谢!

我已经编辑了代码,只显示了1个完整的“部分”,而不是我运行它的每个实例。省略的代码显示为:~~~

Option Explicit

Sub Plant_Schedule()

'All Dim Statements excluded for conciseness

td = Format(Now(), "mm-dd-yyyy") 'it is formatted like this to be used as a sheet name

Set wf = Application.WorksheetFunction

lastday = Format(wf.WorkDay(td, 30), "mm-dd-yyyy") 'only build schedule for 30 days out

nRows = Sheets(1).UsedRange.Rows.Count
nCols = Sheets(1).UsedRange.Columns.Count
datarows = nRows - 2 'leaving out header and total row

ReDim flglws(1 To datarows, 1 To nCols)
For i = 1 To datarows
For j = 1 To nCols
    flglws(i, j) = Sheets(1).Cells(i + 1, j)
Next
Next
ReDim test(1 To LBound(flglws), 1 To UBound(flglws) + 22)

test = departmentstartdate(flglws)
'departmentstartdate is a public function that calculates 
'the different dates for each department 

noldtemp = 0


'~~~~~~~


For i = LBound(test, 1) To UBound(test, 1)
        Select Case test(i, 26)


'~~~~~~~~


            Case Is <= td
            noldtemp = noldtemp + 1

 '~~~~~~~~

        End Select
Next i


ReDim oldtemp(1 To noldtemp, 1 To UBound(test, 2))


'~~~~~~~~


noldtemp = 0


For i = LBound(test, 1) To UBound(test, 1)
    Select Case test(i, 26)

'~~~~~~~~

        Case Is <= td
        noldtemp = noldtemp + 1
        For j = LBound(test, 2) To UBound(test, 2)
            oldtemp(noldtemp, j) = test(i, j)
        Next j

'~~~~~~~~

    End Select
Next i

notgr = 0

Dim oldgrtemp() As Variant

'~~~~~~~~

For i = 1 To UBound(oldtemp, 1)
    Select Case oldtemp(i, 6)
        Case Is = "GR"
            notgr = notgr + 1

            '~~~~~~~
End Select
Next i

ReDim oldgrtemp(1 To notgr, 1 To UBound(oldtemp, 2))

    '~~~~~~~~

notgr = 0

For i = 1 To UBound(oldtemp, 1)
    Select Case oldtemp(i, 6)
        Case Is = "GR"
            notgr = notgr + 1
            For j = 1 To UBound(oldtemp, 2)
                oldgrtemp(notgr, j) = oldtemp(i, j)
            Next j 


            '~~~~~~~~

Next i

' Find Unique Batches
Dim uGRBatches As Variant

Dim ngrUnique As Integer

Dim isUnique As Boolean
Dim iUnique As Integer

ReDim uGRBatches(1 To UBound(oldgrtemp, 1))

    '~~~~~~~~

ngrUnique = 0
For i = 1 To UBound(oldgrtemp, 1)
    isUnique = True
    For iUnique = 1 To ngrUnique
        If oldgrtemp(i, 1) = uGRBatches(iUnique) Then
            isUnique = False
            Exit For
        End If
    Next iUnique
    If isUnique = True Then
        ngrUnique = ngrUnique + 1
        uGRBatches(ngrUnique) = oldgrtemp(i, 1)
    End If
Next i
ReDim Preserve uGRBatches(1 To ngrUnique)

   '~~~~~~~~

' this is where I am stuck, the unique batches have been made but 
' I can not figure out how to setup multiple dynamic arrays
' based on these unique dynamic arrays


End Sub

我为这种混乱道歉,我想这更像是一个如何解决这个问题的概念性问题,而不是已编写代码中的特定问题。

这就是我所提出的,使用三维数组来分离出独特的批次:

Dim h As Integer
Dim gr3d() As Variant

ReDim gr3d(1 To ngrUnique, 1 To UBound(oldgrtemp, 1), 1 To UBound(oldgrtemp, 2))


Dim ngr3d
For h = 1 To ngrUnique
    ngr3d = 0
    For i = 1 To UBound(oldgrtemp, 1)
        If oldgrtemp(i, 1) = uGRBatches(h) Then
            ngr3d = ngr3d + 1
            For j = 1 To UBound(oldgrtemp, 2)
                gr3d(h, ngr3d, j) = oldgrtemp(i, j)
            Next j
        Else
        End If
    Next i
Next h

0 个答案:

没有答案