如何使用vba在excel中查找組值的最大值？

Question

我下表具有如下：

Name Storey Location Value1 Value2 Value3 
B1 6F  0  11  22  33 
B1 6F  1  21  32  10 
B1 6F  2  10  21  35 
B1 5F  0  12  21  34 
B1 5F  1  23  33  9 
B1 5F  2  12  20  36 
B2 6F  1.1  8  20  21 
... 

我想要得到的是找出值1，值2和值3的每個名稱（B1，B2，B3的最大值.. ..）在不同的故事中的同一個位置，並生成一個新的表像下面：

Name Location Value1 Value2 Value3 
B1 0  12  22  34 
B1 1  23  33  10 
B1 2  12  21  36 
B2 ... 

任何人都知道如何使用VBA宏來做到這一點？

謝謝！

Answer 1

嘗試這個公式： 假定位置列是從C2至C8和值1個欄來回D2到D8

{=MAX(IF($C$2:$C$8=$C2,D$2:D$8,FALSE))} 

型式並按下Ctrl +移+輸入

Answer 2

粘貼下面提到vba代碼在模塊中。你只需要修改變量source_rng（包含頭文件的原始數據的範圍）和target_rng（你想要粘貼結果的單元格引用）

例如，如果你的原始數據在範圍H3：m10然後source_rng =。範圍（ 「H3：M10」） - 這個範圍應該包括頭也

現在要粘貼單元格 「O3」 的結果則target_rng = .Range（ 「O3」）

現在。將下面提到的代碼粘貼到模塊中

Sub t() 

Dim myarr() 

Dim myarr_max() 

Dim source_rng As Range 

Dim target_rng As Range 

With ActiveSheet 

    Set source_rng = .Range("h3:m10") 
    Set target_rng = .Range("o3") 
    target_rng.CurrentRegion.Clear 
    source_rng.Copy 
    target_rng.PasteSpecial (xlPasteAll) 
    Selection.Columns(2).Delete shift:=xlToLeft 
    .Range(Selection.Cells(2, 3), Selection.Cells(Selection.Rows.Count, Selection.Columns.Count)).ClearContents 
    Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes 

    For k = 1 To 3 
       For Each target_cell In Selection.Columns(1).Cells 
        i = i + 1 
        If i <> 1 And target_cell <> "" Then 
         target_count = target_count + 1 
         For Each source_cell In source_rng.Columns(1).Cells 
          j = j + 1 
          If j <> 1 Then 
           If target_cell.Value & "_" & target_cell.Offset(0, 1) = source_cell.Value & "_" & source_cell.Offset(0, 2) Then 
            Counter = Counter + 1 
            ReDim Preserve myarr(Counter - 1) 
            myarr(Counter - 1) = source_cell.Offset(0, k + 2) 
           End If 
          End If 
         Next source_cell 

          ReDim Preserve myarr_max(target_count - 1) 
          myarr_max(target_count - 1) = WorksheetFunction.Max(myarr) 
          Erase myarr 
          Counter = 0 
        End If 

       Next target_cell 
      .Range(.Cells(Selection.Rows(2).Row, Selection.Columns(k + 2).Column), .Cells(Selection.Rows(2).Row + UBound(myarr_max), Selection.Columns(k + 2).Column)) = WorksheetFunction.Transpose(myarr_max) 
      Erase myarr_max 
      target_count = 0 
      i = 0 
      j = 0 

    Next k 

End With 

End Sub