如何使用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