Question

我几乎没有vba经验，并且正在尝试通过项目进行学习。将不胜感激一些帮助！我正在寻找一些帮助来构建vba代码来完成以下任务：有一个名为“数据”的工作表，其中包含以下列。

另一张名为“结果”的工作表包含以下列：

目标是在“数据”表中查找每个组（列f）的最高3个值（列e），并在（列d）中将对应的最高3组值的相应“名称”显示在“结果”中的E，F和G列

非常感谢您提供一些帮助！非常感谢！

Answer 1

此代码有效（尽管感觉不佳！）。基本方法是：

创建包含每个组（1,2, & 3）值的数组
使用LARGE()函数获取第一，第二和第三最大值

我假设已根据您的图片设置了数据。

Sub GetNames()
    Dim GRP1() As Integer, GRP2() As Integer, GRP3() As Integer
    Dim rng As Range, cl As Range

    Set rng = Worksheets("Data").Range("E2:E19")

    ReDim GRP1(0 To 0) As Integer
    ReDim GRP2(0 To 0) As Integer
    ReDim GRP3(0 To 0) As Integer

    For Each cl In rng
        If cl.Offset(0, 1) = 1 Then
            GRP1(UBound(GRP1)) = cl
            ReDim Preserve GRP1(0 To UBound(GRP1) + 1) As Integer
        End If

        If cl.Offset(0, 1) = 2 Then
            GRP2(UBound(GRP2)) = cl
            ReDim Preserve GRP2(0 To UBound(GRP2) + 1) As Integer
        End If

        If cl.Offset(0, 1) = 3 Then
            GRP3(UBound(GRP3)) = cl
            ReDim Preserve GRP3(0 To UBound(GRP3) + 1) As Integer
        End If
    Next cl

    Dim results As Range

    Set results = Worksheets("Results").Range("D2:D4")

    For Each cl In results
        With Worksheets("Data")
            If cl = 1 Then
                cl.Offset(0, 1) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP1, 1), rng, 0) + 1)
                cl.Offset(0, 2) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP1, 2), rng, 0) + 1)
                cl.Offset(0, 3) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP1, 3), rng, 0) + 1)
            End If

            If cl = 2 Then
                cl.Offset(0, 1) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP2, 1), rng, 0) + 1)
                cl.Offset(0, 2) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP2, 2), rng, 0) + 1)
                cl.Offset(0, 3) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP2, 3), rng, 0) + 1)
            End If

            If cl = 3 Then
                cl.Offset(0, 1) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP3, 1), rng, 0) + 1)
                cl.Offset(0, 2) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP3, 2), rng, 0) + 1)
                cl.Offset(0, 3) = .Range("D" & WorksheetFunction.Match(WorksheetFunction.Large(GRP3, 3), rng, 0) + 1)
            End If
        End With
    Next cl
End Sub

Answer 2

这是使用adodb的方法。

Sub GetTop3()
    Dim vGroup As Variant, vDB As Variant, vR() As Variant
    Dim i As Long, j As Long, c As Integer, n As Long
    Dim Ws As Worksheet
    Dim strSQL As String

    Set Ws = Sheets("Results")

    strSQL = "SELECT Country, State, City, Group, name "
    strSQL = strSQL & "FROM [Data$] "
    strSQL = strSQL & "WHERE [Value] IN( SELECT TOP 3 [Value]  FROM [Data$] AS A   "
    strSQL = strSQL & "WHERE  A.Group = [Data$].Group  "
    strSQL = strSQL & "ORDER BY Value DESC;) "
    strSQL = strSQL & "ORDER BY Group,value desc,Country, State , City "


    vDB = getRs(strSQL)

    strSQL = "Select country, State, City, Group from [Data$] group by Country, State, City, Group order by Group "
    vGroup = getRs(strSQL)

    n = UBound(vDB, 2)
    ReDim Preserve vR(0 To 6, 0 To n)
    For i = 0 To UBound(vGroup, 2)
        c = 3
        For j = 0 To 3
            vR(j, i) = vGroup(j, i)
        Next j

        For j = 0 To n
            If vGroup(3, i) = vDB(3, j) Then
                c = c + 1
                If c > 6 Then Exit Sub
                vR(c, i) = vDB(4, j)
            End If
        Next j
    Next i
    With Ws
        .UsedRange.Clear
        .Range("a1").Resize(1, 7) = Array("Country", "State", "City", "Group", "1st Name", "2nd Name", "3rd Name")
        .Range("a2").Resize(n + 1, 7) = WorksheetFunction.Transpose(vR)
    End With


End Sub
Function getRs(str As String) As Variant

    Dim Rs As Object
    Dim strConn As String
    Dim i As Integer

    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties=Excel 12.0;"


    Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open str, strConn

    getRs = Rs.getRows()

    Rs.Close
    Set Rs = Nothing
End Function

VBA在不同的工作表中查找组并返回前3个值和名称

2 个答案: