在動態範圍內找到MAX並重復其餘數據的代碼

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（如果它們不是最大值）。如果每個材料的最大值有多個進程，則它們都會打印。 我知道材料不會按順序排列，但您的示例確實按材料排序，並且代碼要求按照您的示例對它們進行排序。

TESTED：看到

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 

CHECK IF PROCESS落入範圍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 

CONVERT信NUMBER：

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 

編輯：修訂方案來解決OP