組內尋找最大價值，並複製使用VBA

Question

我想找到一個組內的最大值整行（按：列A，最大值：列E）和複製整個原材料​​到下表中的Excel。

ABCDE

1-10-4-2-5.491

1-10-5-2-5.8

1-20-4-3-4.498

2- 30-5-3-6.663

2-30-6-4-8.205

2-10-4-5-8.562

3-10-5-6-7.026

3-30-7-2-10.665

3-30-8-2-8.472

4-10-4-1- 4.489

4-10-5-1-5.491

4-25-7-3-0.816

我的期望是讓輸出如下面另一個表。

1-10-5-2-5.8

2-10-4-5-8.562

3-30-7-2-10.665

4-10-5-1 -5.491

請提出的解決方案。（優選的是具有在VBA的溶液）謝謝。

Answer 1

這是一個基於VBA的解決方案，構建了以下內容：

Option Explicit 
Sub FindMaximums() 

Dim DataSheet As Worksheet, MaxSheet As Worksheet 
Dim LastDataRow As Long, GroupCol As Long, _ 
    MeasureCol As Long, CurrentGroup As Long, _ 
    MaxMeasureRow As Long, RowIdx As Long, _ 
    LastMaxRow As Long 
Dim MaxMeasureValue As Double 
Dim DataRng As Range, MaxRng As Range 

'identify sheets and columns for easy reference 
Set DataSheet = ThisWorkbook.Worksheets("Data") 
Set MaxSheet = ThisWorkbook.Worksheets("Maximums") 
GroupCol = 1 'grouping info in column A 
MeasureCol = 5 'measure for comparison in column E 

'identify the last row to set bounds on our loop 
LastDataRow = DataSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

'initialize group and max variables 
CurrentGroup = 1 
MaxMeasureValue = 0 
MaxMeasureRow = 1 
LastMaxRow = 1 

'loop through all rows 
For RowIdx = 2 To LastDataRow 

    'check to see if there has been a group change 
    If DataSheet.Cells(RowIdx, GroupCol).Value > CurrentGroup Then 

     'write out the max measure row 
     Set DataRng = Range(DataSheet.Cells(MaxMeasureRow, GroupCol), DataSheet.Cells(MaxMeasureRow, MeasureCol)) 
     Set MaxRng = Range(MaxSheet.Cells(LastMaxRow, GroupCol), MaxSheet.Cells(LastMaxRow, MeasureCol)) 
     DataRng.Copy MaxRng 

     'initialize and increment 
     CurrentGroup = DataSheet.Cells(RowIdx, GroupCol).Value 
     MaxMeasureValue = 0 
     MaxMeasureRow = 1 
     LastMaxRow = LastMaxRow + 1 

    End If 

    'evaluate max measure logic 
    If DataSheet.Cells(RowIdx, MeasureCol).Value > MaxMeasureValue Then 
     MaxMeasureValue = DataSheet.Cells(RowIdx, MeasureCol).Value 
     MaxMeasureRow = RowIdx 
    End If 

Next RowIdx 

'write out the last maximums 
Set DataRng = Range(DataSheet.Cells(MaxMeasureRow, GroupCol), DataSheet.Cells(MaxMeasureRow, MeasureCol)) 
Set MaxRng = Range(MaxSheet.Cells(LastMaxRow, GroupCol), MaxSheet.Cells(LastMaxRow, MeasureCol)) 
DataRng.Copy MaxRng 

End Sub 

Answer 2

F欄添加一個輔助公式，把它稱爲「最大」或什麼，然後把這個數組公式的第一個數據行（我假設第2行）：

=E2=MAX(IF(A2=$A$2:$A$13,$E$2:$E$13)) 

注意數組公式需要通過按Ctrl + Shift + Enter（而不僅僅是Enter）來提交。

填寫公式。

您現在有一列TRUE/FALSE值。自動篩選此列並選擇TRUE。

將結果複製並粘貼到新工作表。