Question

我想通过仅使用VBA获得每列中具有10个最高值的名称。列名称的列表是在参数中指定的，并且列和行的数量不是固定的，因此我需要动态的东西。这是我的数据

names   mod1  mod2   ...   modn

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

我想要这样的结果。例如，两列mod8和mod13的列表。是否可以仅使用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

Answer 1

您也可以使用SQL语句来完成这一操作。为此，您需要确保您具有列标题，添加对Microsoft ActiveX Data Object 2.8 Library或更高版本的引用，并安装了Microsoft.ACE.OLEDB.12.0驱动程序（MS Access随附）。

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

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

Answer 2

让我们假设数据出现在工作表1中。尝试：

Option Explicit

Sub TEST()

    Dim R As Long, C As Long, LastColumn As Long, LastRow As Long, LastRowInitial As Long, LastRowSecond As Long
    Dim strmodName As String, strName As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRowInitial = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For C = 2 To LastColumn
            strmodName = .Cells(1, C).Value

            LastRow = .Cells(.Rows.Count, C).End(xlUp).Row

            For R = 2 To LastRow
                strName = .Cells(R, 1).Value

                If .Cells(R, C).Value > 10 Then

                    LastRowSecond = .Cells(.Rows.Count, 7).End(xlUp).Row

                    If LastRowSecond = 1 And .Cells(1, 7).Value = "" Then
                        .Cells(LastRowSecond, LastColumn + 3).Value = "Name"
                        .Cells(LastRowSecond, LastColumn + 4).Value = "Value"
                        .Cells(LastRowSecond + 2, LastColumn + 2).Value = strmodName
                        .Cells(LastRowSecond + 2, LastColumn + 3).Value = strName
                        .Cells(LastRowSecond + 2, LastColumn + 4).Value = .Cells(R, C).Value
                    Else
                        If R = 2 Then
                            .Cells(LastRowSecond + 1, 6).Value = strmodName
                        End If
                            .Cells(LastRowSecond + 1, LastColumn + 3).Value = strName
                            .Cells(LastRowSecond + 1, LastColumn + 4).Value = .Cells(R, C).Value
                    End If

                End If

            Next R

        Next C

    End With

End Sub

vba每列的名称具有10个最高值的名称

2 个答案: