Question

我想要一个宏，可以从我的样本数据中找到列B到G之间的前三个值，然后将值复制并粘贴到列Q中的另一列，其中包含来自它的行（在列A和行内（行） A）它来自。

EG。

   D1 D2 D3
                                              Seq RowA ColumnA
T1 10 20 30              After running macro:  T1  D3   30
T2 11 22  2                                    T2  D2   22
T3 2  3  10                                    T4  D3   21
T4 6 19  21         


Sub Top3() 
    Dim rng As Range 
    Dim i As Integer 
    Dim r As Integer 
    Range("B2").CurrentRegion.Copy 
    Range("Q2").PasteSpecial Paste:=xlPasteValues 
    Range("Q2").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlDescending 
    r = 5 
    For i = 1 To 3
        Cells(r, "R") = Cells(r + 1, "A") 
        Cells(r, "S") = Cells(r + 1, "A") 
        r = r + 1 
    Next 

    Range("B2").CurrentRegion.Clear 
    Range("C2").Activate 

End Sub

Answer 1

Target：值列表中的所有单元格
Target是3列x 4行Target.Address = $B$2:$D$5
Target(1)指的是第一个单元格
Target(Target.Cells.Count)是最后一个单元格
Target(x)受其列绑定
- Target(4)与Target.Cells(2, 1)
Target(x)不受其行的约束
- Target中的第一列是B列，最后一行是5. Target范围之外的下一个单元格是B列第6行
- Target(Target.Cells.Count + 1).Address = $B$6

通过这些信息，我们可以创建Data的一维数组，其索引和值与Target的索引和值匹配。使用1D数组可以使用内置的Excel WorksheetFunctions轻松引用Target范围内的单元格。

Sub GetTop3()
    Dim Data
    Dim Target As Range
    Dim index As Long, x As Long

    Set Target = Range("Offset(B1,1,0,Counta(B:B)-1,3)")
    ReDim Data(1 To Target.Cells.Count)

    For x = 1 To Target.Cells.Count
        Data(x) = Target(x)
    Next

    For x = 2 To 4
        index = WorksheetFunction.Match(WorksheetFunction.Max(Data), Data, 0)
        With Target(index)
            Cells(x, "R") = Rows(.Row).Columns("A")
            Cells(x, "S") = Cells(1, .Column)
            Cells(x, "T") = .Value
        End With
        Data(index) = vbNullString
    Next

End Sub

此博客显示了如何使用Offset工作表功能来调整范围：Advanced Excel Dynamic Named Ranges

将前3个值从数据复制到另一个列

1 个答案: