Question

我使用以下代码循环遍历电子表格中的行，并将唯一的项目保存到2D数组中。我知道唯一项目的数量， arrLen 变量保存该数字。

如果找到具有相同prNr（标识一组项目的唯一编号）作为前一行的行，则会进行检查以查看哪个具有较低的优先级。如果优先级较低，则应替换2D数组中的项目。

我的问题是 prArrCount 变量增加超过电子表格中唯一prNr条目的数量。据我说它不应该这样做，但有人可以帮我找出原因吗？

'Cycle through PRs, store values in 2D array
'Create 2D array
Dim prData() As String
ReDim prData(arrLen, 6)

'Find the last row in the spreadsheet to iterate through all entries
Dim lastRow As Integer
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Create data variables
Dim i, prArrCount As Integer
Dim prNr As String
Dim description As String
Dim Value As Double
Dim srmRFQ As String
Dim requisitionDate As Date
Dim deliveryDate As Date
Dim delivery As Integer
Dim delta As Integer
Dim priority As Integer
Dim newPR As Integer
Dim initFlag As Integer

'Set initial values
initFlag = 1
prArrCount = 0
newPR = 1

'Start for loop to iterate through all entries in the spreadsheet
For i = 2 To lastRow
    'Read in the PR line values
    prNr = Range("B" & i).Value
    description = Range("G" & i).Value
    srmRFQ = Range("E" & i).Value
    requisitionDate = DateValue(Range("O" & i).Value)
    Value = Range("R" & i).Value
    If Not Left(Range("P" & i).Value, 1) = "0" Then
        deliveryDate = DateValue(Range("P" & i).Value)
    Else
        deliveryDate = 0
    End If
    If Range("S" & i).Value = "" Then
        delivery = 0
    Else
        delivery = Range("S" & i).Value
    End If
    If Range("Z" & i).Value = "Invalid" Then
        priority = 9999
        delta = 0
    Else
        priority = Range("Z" & i).Value
        delta = Range("Y" & i).Value
    End If

    'Check if it is the first iteration of the loop
    If initFlag = 1 Then
        initFlag = 0
    ElseIf Not prNr = prData(prArrCount, 0) Then
        prArrCount = prArrCount + 1
        newPR = 1
    End If

    'Check if values should be written into 2D PR array
    If newPR = 1 Then
        prData(prArrCount, 0) = prNr            '(0) PR Number
        prData(prArrCount, 1) = description     '(1) Description
        prData(prArrCount, 2) = priority        '(2) Days left to order
        prData(prArrCount, 3) = deliveryDate    '(3) Delivery date
        prData(prArrCount, 4) = delivery        '(4) Lead time
        newPR = 0
    ElseIf priority < prData(prArrCount, 2) Then
        prData(prArrCount, 0) = prNr            '(0) PR Number
        prData(prArrCount, 1) = description     '(1) Description
        prData(prArrCount, 2) = priority        '(2) Days left to order
        prData(prArrCount, 3) = deliveryDate    '(3) Delivery date
        prData(prArrCount, 4) = delivery        '(4) Lead time
    End If
Next i

Answer 1

我喜欢使用脚本词典来管理重复项。下面创建一个脚本字典，并添加一个5行1D数组作为任何新prNr的值。如果prNr存在，则检查先前版本的priority是否更大，如果存在，则将新数组存储为字典中该键的值。

'Cycle through PRs, store values in 2D array
'Create 2D array
Dim prData() As String
ReDim prData(arrLen, 6)

'Find the last row in the spreadsheet to iterate through all entries
Dim lastRow As Integer
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Create data variables
Dim i as Integer, prArrCount As Integer
Dim prNr As String
Dim description As String
Dim Value As Double
Dim srmRFQ As String
Dim requisitionDate As Date
Dim deliveryDate As Date
Dim delivery As Integer
Dim delta As Integer
Dim priority As Integer
Dim newPR As Integer
Dim initFlag As Integer
Dim dict As New Scripting.Dictionary 'Note you need the Microsoft Scripting Runtime Library
Dim x(4) as Variant
Dim Key as Variant
Dim Anchor as Range

'Set initial values
initFlag = 1
prArrCount = 0
newPR = 1

'Start for loop to iterate through all entries in the spreadsheet
For i = 2 To lastRow
    'Read in the PR line values
    prNr = Range("B" & i).Value
    description = Range("G" & i).Value
    srmRFQ = Range("E" & i).Value
    requisitionDate = DateValue(Range("O" & i).Value)
    Value = Range("R" & i).Value
    If Not Left(Range("P" & i).Value, 1) = "0" Then
        deliveryDate = DateValue(Range("P" & i).Value)
    Else
        deliveryDate = 0
    End If
    If Range("S" & i).Value = "" Then
        delivery = 0
    Else
        delivery = Range("S" & i).Value
    End If
    If Range("Z" & i).Value = "Invalid" Then
        priority = 9999
        delta = 0
    Else
        priority = Range("Z" & i).Value
        delta = Range("Y" & i).Value
    End If

    x(0) = prNr
    x(1) = description
    x(2) = priority
    x(3) = deliveryDate
    x(4) = delivery


    If Not dict.Exists(prNr) Then
        dict.Add prNr, x
    Else
        If priority < dict(prNr)(2) Then
            dict(prNr) = x
        End If
    End If
Next i

With Workbooks("Workbook Name").Sheets("Sheet Name") 'Change references to match what you need
    For Each Key in dict.Keys
        Set Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
            For i = Lbound(dict(key),1) to Ubound(dict(key),1)
                Anchor.Offset(0,i) = dict(key)(i)
            Next i
    Next key
End With

请看我的编辑。这将在新行中输出每个键，并且数组中的每个元素都与从A列开始的键相关。您只需更新工作簿，工作表和范围以满足您的需求。

使用值比较在2D数组中保存唯一行

1 个答案: