複製頂端從數據3的值到另一個柱

Question

我想要一個宏，可以從列之間我的樣本數據找到頂部3個值B至G，然後複製並粘貼在與它是從行q列的值到另一列（A欄和行（A行）內它來自

例如

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

利用這個信息，我們可以創建一個1的Data數組的索引和值匹配Target。使用1D數組可以很容易地使用內置的Excel工作表函數在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 WorksheetFunction調整大小範圍：Advanced Excel Dynamic Named Ranges