excel - vba每列的名称具有10个最高值的名称(names that have 10 highest values for each column with vba)

Question

I want to get names that have the 10 highest values in each column by using only VBA.

(我想通过仅使用VBA来获取每列中具有10个最高值的名称。)

The list of column names is specified in an argument, and the number of columns and rows are not fixed, so I need something dynamic.

(列名称的列表是在参数中指定的，并且列和行的数量不是固定的，因此我需要动态的东西。)

This is my data

(这是我的资料)

names   mod1  mod2   ...   modn

name1    1     5     ...    3
name2    2           ...    1
name3          2     ...    
name4    9     13    ...    22
 ...     
namen    61    7            4

And i want a result like that.

(我想要这样的结果。)

For example a list of two columns mod8 and mod13.

(例如，两列mod8和mod13的列表。)

is it possible by using only vba, and how should i do it, i'm new in vba.

(仅使用vba是否有可能，我应该怎么做，我是vba的新手。)

        name          value

mod8    name8         123
        name1135      92
        name1136      22
        name23037     17
        name1138      15
        name1139      6
        name5140      5
        name1141      4
        name1142      2
        name1143      1

mod13   name2         7
        name1         6
        name5         3
        name7         1

  ask by Hat na translate from so

Answer 1

You can use a SQL statement too to accomplish this one.

(您也可以使用SQL语句来完成这一操作。)

For this to work you'll need to make sure you have column headers, add a reference to Microsoft ActiveX Data Object 2.8 Library or greater, and the Microsoft.ACE.OLEDB.12.0 driver installed (it comes with MS Access).

(为此，您需要确保具有列标题，添加对Microsoft ActiveX Data Object 2.8 Library或更高版本的引用，并安装了Microsoft.ACE.OLEDB.12.0驱动程序（MS Access附带）。)

Make sure to update the sheet references, as I made up a contrived example.

(请确保更新工作表引用，因为我做了一个人为的示例。)

Option Explicit

Public Sub GetTopTenValues()
    Dim ws          As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet3")
    Dim outsheet    As Worksheet: Set outsheet = ThisWorkbook.Worksheets("Sheet4")
    Dim lastRow     As Long
    Dim lastCol     As Long
    Dim conn        As ADODB.Connection: Set conn = New ADODB.Connection
    Dim rs          As ADODB.Recordset: Set rs = New ADODB.Recordset
    Dim sql         As String
    Dim i           As Long

    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 12.0 Xml;HDR=YES';"
    conn.Open
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    For i = 2 To lastCol
        sql = "Select top 10 [names], [" & ws.Cells(1, i).Value2 & "] from [Sheet3$] order by [" & ws.Cells(1, i).Value2 & "] desc"
        rs.Open sql, conn
        lastRow = outsheet.Cells(outsheet.Rows.Count, "A").End(xlUp).Row + 1
        outsheet.Range("A" & lastRow).CopyFromRecordset rs
        rs.Close
    Next

    conn.Close
End Sub