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

我的下表如下：

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
...

我想得到的是，在不同故事的相同位置，找出每个名称（B1、B2、B3…）的值1、值2和值3的最大值，并生成如下所示的新表：

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

有人知道如何使用VBA宏来实现这一点吗

谢谢

试试这个公式： 假设位置列从c2到c8，值1列从d2到d8

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

---

键入公式，然后按ctrl+shift+enter键将下面提到的vba代码粘贴到模块中。您只需要修改变量source_rng（包含头的原始数据的范围）和target_rng（要粘贴结果的单元格引用）

例如，如果您的原始数据在H3:m10范围内，则source\u rng=.range（“H3:m10”）-此范围还应包括标题

现在要将结果粘贴到单元格“o3”中，然后target\u 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

subt（）
Dim myarr（）
Dim myarr_max（）
暗光源作为范围
变暗目标\u rng As范围
使用ActiveSheet
设置源代码=.Range（“h3:m10”）
设置目标值=.Range（“o3”）
目标\u rng.CurrentRegion.Clear
来源\u rng.Copy
目标\u rng.PasteSpecial（xlPasteAll）
Selection.Columns（2）.删除移位：=xlToLeft
.Range（Selection.Cells（2,3），Selection.Cells（Selection.Rows.Count，Selection.Columns.Count））.ClearContent
Selection.removedupplicates列：=数组（1,2），标题：=xlYes
对于k=1到3
对于Selection.Columns（1）中的每个目标单元格
i=i+1
如果i 1和目标_单元格“”，则
目标计数=目标计数+1
对于源代码列（1）中的每个源代码单元格
j=j+1
如果j1那么
如果目标单元格值和目标单元格偏移量（0，1）=源单元格值和源单元格偏移量（0，2），则
计数器=计数器+1
ReDim保留myarr（计数器-1）
myarr（计数器-1）=源单元偏移量（0，k+2）
如果结束
如果结束
下一个源单元
ReDim Preserve myarr\u max（目标计数-1）
myarr\u max（target\u count-1）=WorksheetFunction.max（myarr）
清除myarr
计数器=0
如果结束
下一个目标单元
.Range（.Cells（Selection.Rows（2）.Row，Selection.Columns（k+2）.Column），.Cells（Selection.Rows（2）.Row+UBound（myarr\u max），Selection.Columns（k+2.Column））=工作表函数.Transpose（myarr\u max）
删除myarr_max
目标计数=0
i=0
j=0
下一个k
以
端接头

是否需要使用宏执行此操作？