Vba 在动态范围内查找MAX，并对其余数据重复代码_Vba_Excel

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

vba excel

Vba 在动态范围内查找MAX，并对其余数据重复代码,vba,excel,Vba,Excel,我有一个代码，可以找到一组物料编号的最长时间，但无法将代码重复到下一组物料编号。请参考下面的数据表和代码物料编号从1001、1002、1003..更改，物料编号将不按顺序排列。要考虑的行仅用于流程a到h。 a.1、a.2、h.1和h.2需要从最大值范围中排除如果重复最大值，下面的代码也将只取第一个最大值。请告知如何重复其余材料编号的代码，并仅采用工艺范围a-h。如果我们可以引用流程，因为某些范围可能有额外/更少的流程样本数据： Material Process Time (m

我有一个代码，可以找到一组物料编号的最长时间，但无法将代码重复到下一组物料编号。请参考下面的数据表和代码

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

如果重复最大值，下面的代码也将只取第一个最大值。
请告知如何重复其余材料编号的代码，并仅采用工艺范围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

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

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

样本最终结果：

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

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

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

当前代码：

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

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

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

子测试（）
将LastRowB设置为字符串
暗淡的最后一行
Dim VarC为双
作为整数的Dim i
将varMAX设置为双精度
LastRowB=单元格（Rows.Count，“B”）.End（xlUp）.Row
LastRowC=单元格（Rows.Count，“C”）.End（xlUp）.Row
VarC=范围（“C4”）.值
对于i=2至LastRowC
如果范围（“C”&i）.Value>VarC，则
VarC=范围（“C”&i）.值
如果结束
接下来我
对于i=2至LastRowC
如果范围（“C”&i）.值

这是根据上述评论修订的：

这将保留原始图纸，遍历并将列C值设置为0（如果它们不是=最大值）。如果每个材质有多个进程具有最大值，则它们都将打印。我知道这些材料不会按顺序排列，但您的示例确实按材料对它们进行了排序，代码要求它们像您的示例一样进行排序

测试：

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

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

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

编辑：解决OP的修订解决方案

您试图对输出做什么？@PJ Rosenburg输出将在除第一个最大值之外的所有其他时间更改为零。我需要对可用材料的质量变化数据进行分析。我曾尝试录制宏（使用if函数），但范围不灵活。根据物料编号，流程可能会有所不同。@PJ Rosenburg感谢您的帮助：）最终结果是我需要维护流程表，而不是结果表中可见的最大流程和时间。我仍然需要流程a.1-h.2可用，只显示最长时间，其他时间更改为零。@PJ Rosenburg抱歉造成混淆。我用最终结果的样本编辑了我的问题，如果你能看一看吗？看到修改后的答案，我想我们赢了。