Question

我有一个代码已经可以找到一组材料编号的最大时间，但是仍然坚持将代码重复到下一组材料编号。请参阅下面的数据表和代码。

材料编号从 1001,1002,1003 .. 更改材料编号将不按顺序排列。
要考虑的行仅适用于 a 过程，直到 h a.1，a.2，h.1 和 h.2 需要从最大值范围中排除。

如果重复最大值，下面的代码也只会取第1个最大值请告知如何重复其余材料编号的代码，并仅采用流程 a-h 的范围。可能我们可以参考该过程，因为某些范围可能有额外/更少的过程。

示例数据：

Material    Process   Time (mins)
1001          a.1        0.00
1001          a.2        0.00
1001          a          0.50
1001          b          0.70
1001          c          1.00
1001          d          2.50
1001          e          1.00
1001          f          0.30
1001          g          0.50
1001          h          0.90
1001          h.1        0.00
1001          h.2        0.00
1002          a.1        0.00
1002          a.2        0.00
1002          a          0.40
1002          b          0.60
1002          c          1.00
1002          d          2.00
1002          e          2.00
1002          f          0.30
1002          g          0.80
1002          h          0.50
1002          h.1        0.00
1002          h.2        0.00

示例结束结果：

Material    Process   Time (mins)
1001          a.1        0.00
1001          a.2        0.00
1001          a          0.00
1001          b          0.00
1001          c          0.00
1001          d          2.50
1001          e          0.00
1001          f          0.00
1001          g          0.00
1001          h          0.00
1001          h.1        0.00
1001          h.2        0.00
1002          a.1        0.00
1002          a.2        0.00
1002          a          0.00
1002          b          0.00
1002          c          0.00
1002          d          2.00
1002          e          0.00
1002          f          0.00
1002          g          0.00
1002          h          0.00
1002          h.1        0.00
1002          h.2        0.00

当前代码：

Sub test()

Dim LastRowB As String
Dim LastRowC As Long
Dim VarC As Double
Dim i As Integer
Dim varMAX as Double

LastRowB = Cells(Rows.Count, "B").End(xlUp).Row
LastRowC = Cells(Rows.Count, "C").End(xlUp).Row

VarC = Range("C4").Value

For i = 2 To LastRowC
   If Range("C" & i).Value > VarC Then
       VarC = Range("C" & i).Value
   End If
Next i

For i = 2 To LastRowC
   If Range("C" & i).Value < VarC Then
       Range("C" & i).Value = 0
   End If
Next i

varMax = 0
For i = 2 To LastRowC
 If Range("C" & i).Value < VarC Then
      Range("C" & i).Value = 0
  Else
      If Range("C" & i).Value = VarC And varMax < 1 Then
       varMax = varMax + 1
   Else
       Range("C" & i).Value = 0
   End If
 End If
 Next i
    End Sub

Answer 1

根据上述评论进行修订：

如果它们不是=最大值，则保留原始工作表，通过并将列C值设置为0。如果每个材料的最大值有多个进程，则它们都将打印。我知道材料不会按顺序排列，但是您的示例确实按材料排序，并且代码要求它们按照您的示例进行排序。

<强>试验：

Sub test()

Dim LastRow As Long
Dim tempMaterial As String
Dim newMaterial As String
Dim tempProcess As String

Dim VarC As Double
Dim tRow As Long                'Used for Result - Can Remove
Dim tempMaxRow As Long
Dim tempMinRow As Long

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

sheetName = "Sheet1"            'Set SheetName here
VarC = 0
tempMaterial = ""
tempMinRow = 2

'Begin loop through sheet.  If the materials don't match, 
'go back and rewrite "C" values for last Material

For lRow = 2 To LastRow + 1
    newMaterial = Sheets(sheetName).Cells(lRow, 1).Text
    If tempMaterial <> newMaterial And tempMaterial <> "" Then
        tempMaxRow = lRow - 1
        If tempMaxRow > 2 Then
            For r = tempMinRow To tempMaxRow     'Go through temp range of material
                If Sheets(sheetName).Cells(r, 3) < VarC Then
                    Sheets(sheetName).Cells(r, 3) = 0
                End If
            Next r
        End If

        'Set the new temp Material & Reset the Max Variable
        tempMaterial = newMaterial
        VarC = 0
        highProcess = ""
        tempMinRow = lRow

    End If

    'This gets done regardless of new material
    tempProcess = Sheets(sheetName).Cells(lRow, 2).Text
    If Len(tempProcess) = 1 Then                                'Make sure process only has one letter
        If ProcessCheck(tempProcess) = True Then                'Check to see if it's A-H
            If Sheets(sheetName).Cells(lRow, 3) > VarC Then     'Check against Max value
                tempMaterial = Sheets(sheetName).Cells(lRow, 1) 'Set Temp Material
                VarC = Sheets(sheetName).Cells(lRow, 3)         'Set new max if greater than old
            End If
        End If
    End If

Next lRow

End Sub

检查过程是否在A-H范围内下降：

Function ProcessCheck(process As String) As Boolean

Dim pass As Boolean

    pass = False

    If LetterToNumber(process) <= 8 Then    '8 is the numeric value of "H"
        pass = True
    End If

    ProcessCheck = pass

End Function

将数字转换为数字：

Function LetterToNumber(letter As String) As Long

Dim result As Long

    result = 0
    result = (Asc(UCase(Mid(letter, 1, 1))) - 64) + result * 26
    LetterToNumber = result

End Function

Solution

编辑：修改解决方案来解决OP

在动态范围内查找MAX并重复其余数据的代码

1 个答案: