如何根据另一列中的最高数量在列中选择最高数字

Question

| Part Name | Issue Number | Sequence Number
    A1          1              1
    A1          1              2
   **A1         2              1**
   **A2         1              1**
    A3          1              1
    A3          1              2
    A3          1              3
    A3          2              1
    A3          3              1
    A3          4              1
    A3          4                  2
   **A3          4                  3**
    A4          1              1
    A4          1              2
   **A4         1              3**
    B1          1              1
    B1          2              1
    B1          2              2
    B1          3              1
    B1          3              2
    B1          3              3
    B1          3              4
    B1          3              5
    B1          3              6
    B1          4              1
   **B1         5              1**

我有三列，第一个是零件号，第二个是发行号，第三列是序列号。我想为每个零件名称选择最高的问题编号，然后选择该问题编号的最高序列编号，然后将所有序列编号放在Sperate Excel表中。

我使用了chatgpt并获得了此代码。它行不通。如果您知道解决方案，请提供帮助。

Sub AlignDataAndCreateTabs()
    Dim ws As Worksheet, newWs As Worksheet
    Dim lastRow As Long, uniqueItem As Object
    Dim rng As Range, cell As Range
    Dim item As Variant, maxVal2 As Double, maxVal3 As Double
    Dim dict As Object, sheetName As String
    
    ' Set reference to active sheet
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Get last row in column A
    
    Set uniqueItem = CreateObject("Scripting.Dictionary") ' Store unique items from Column A
    Set dict = CreateObject("Scripting.Dictionary") ' Store max values for each unique item
    
    ' Loop through Column A to get unique items
    For Each cell In ws.Range("A2:A" & lastRow)
        item = cell.Value
        If Not uniqueItem.Exists(item) Then
            uniqueItem.Add item, Nothing
        End If
    Next cell
    
    ' Process each unique item
    For Each item In uniqueItem.Keys
        maxVal2 = -1: maxVal3 = -1 ' Initialize max values
        
        ' Loop through the sheet to find max in Column B for each unique Column A item
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item Then
                If IsNumeric(cell.Offset(0, 1).Value) And cell.Offset(0, 1).Value > maxVal2 Then
                    maxVal2 = cell.Offset(0, 1).Value
                End If
            End If
        Next cell
        
        ' Find max in Column C corresponding to maxVal2
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item And cell.Offset(0, 1).Value = maxVal2 Then
                If IsNumeric(cell.Offset(0, 2).Value) And cell.Offset(0, 2).Value > maxVal3 Then
                    maxVal3 = cell.Offset(0, 2).Value
                End If
            End If
        Next cell
        
        ' Store results
        dict.Add item, Array(maxVal2, maxVal3)
    Next item
    
    ' Create new sheets and add selected values
    Application.ScreenUpdating = False
    For Each item In dict.Keys
        ' Sanitize sheet name
        sheetName = Left(WorksheetFunction.Clean(CStr(item)), 31)
        sheetName = Replace(sheetName, "\", "_")
        sheetName = Replace(sheetName, "/", "_")
        sheetName = Replace(sheetName, "?", "_")
        sheetName = Replace(sheetName, "*", "_")
        sheetName = Replace(sheetName, "[", "_")
        sheetName = Replace(sheetName, "]", "_")
        
        On Error Resume Next
        Set newWs = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Sheets.Add
            newWs.Name = sheetName
        End If
        
        ' Write headers
        newWs.Cells(1, 1).Value = "Item"
        newWs.Cells(1, 2).Value = "Max Column B"
        newWs.Cells(1, 3).Value = "Max Column C"
        
        ' Write values
        Dim rowIndex As Integer
        rowIndex = 2
        For Each cell In ws.Range("A2:A" & lastRow)
            If cell.Value = item Then
                newWs.Cells(rowIndex, 1).Value = item
                newWs.Cells(rowIndex, 2).Value = dict(item)(0)
                newWs.Cells(rowIndex, 3).Value = dict(item)(1)
                rowIndex = rowIndex + 1
            End If
        Next cell
        
        Set newWs = Nothing
    Next item
    Application.ScreenUpdating = True
    
  
End Sub

按照评论，您可以通过以下公式-

Answer 1

=DROP(LET(arr,SORT(A1:C26,{1,2,3},{1,-1,-1}),
fx,CHOOSECOLS,
REDUCE("",UNIQUE(fx(arr,1)),LAMBDA(a,x,VSTACK(a,TAKE(FILTER(arr,fx(arr,1)=x),1))))),1)

输入数据：

a111a112a121a211a311a312a313a321a331a341a342a343a411a412a413B111B121B122B131B132B133B134B135B136B141B151输出结果：

a121a211a343a413B151