在dynamic范围内查找MAX，并为其余数据重复该代码
我有一个代码，已经可以find一组材料号的最大时间，但坚持重复代码到下一组材料号码。 请参考下面的数据表和代码。
物料编号从1001,1002,1003变化..物料编号将不按顺序。
要考虑的行是用于过程a直到只有h 。
a.1，a.2，h.1和h.2需要排除在最大值范围之外。
下面的代码在重复最大值的情况下也只会取第一个最大值。
请告知如何重复其余的材料编号的代码，并只采取过程的范围啊 。 可能的话，如果我们可以参考这个过程，因为一些范围可能有更多/更less的过程。
样本数据：
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
这是根据上面的评论修改的：
这将保留原始图纸，并将C列值设置为0，如果它们不是最大值。 如果每个材料的最大值有多个进程，则会同时打印。 我知道材料不会按顺序排列，但是您的示例确实按照材质sorting，代码要求按照您的示例sorting。
testing：
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 AH 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
检查在AH范围内是否有过程错误：
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
编辑：修改解决scheme来解决OP