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

我想得到的是在不同故事的同一位置找出每个名称（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宏来执行此操作？

谢谢！

Answer 1

将下面提到的vba代码粘贴到模块中。您只需要修改变量source_rng（包含标题的原始数据的范围）和target_rng（要粘贴结果的单元格引用。

例如，如果您的原始数据在H3：m10范围内，则 source_rng = .Range（＆＃34; h3：m10＆＃34;） - 此范围也应包括标题。

现在您要将结果粘贴到单元格＆＃34; o3＆＃34;然后 target_rng = .Range（＆＃34; o3＆＃34;）

现在在Module

中粘贴下面提到的代码

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

Answer 2

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

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

输入公式并按ctrl + shift + enter

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

2 个答案: