返回多个记录的单个值

时间:2011-12-15 03:41:06

标签: excel vba excel-vba

有没有办法合并多个记录,然后只显示每列的最高值?示例:A2:A25 =名称,B2 = Grade1,C2 = Grade2 ......等。 首先,我删除了重复项,以防有确切的重复。然后我按名字排序。 是否可以根据列A名称将某些内容添加到此代码中,以使用每列中的最高值显示每个名称一次? = IF(B2 = “”, “空”,IF(B2 = “高”, “高”,IF(B2 = “医学”, “医学”,IF(B2 = “低”, “低”, “” ))))

数据示例

A1:name B1:Grade1 C1:Grade2...etc
A2:Joe B2:High C3:Low
A3:Joe B3:Med C3:High
A4:Dan B4:Low C4:Med
A5:Dan B5:Low C5:Low

_ _结果:Joe Grade1 = high Grade2 = high,Dan:Grade1 = Low Grade2 = Med

2 个答案:

答案 0 :(得分:0)

记录Excel宏。选择第一列。单击高级过滤器。选择复制到位置并选择一个新列,例如X.启用唯一过滤器。现在单击确定。现在看一下vba source来获取代码以获取列中的唯一元素。现在将Low指定为0,将Med指定为1,将High指定为2。循环遍历行,找到对应于列X中每个元素的最大等级1,最高等级2等,并填充Y,Z等列。当您找到新的最大值时,替换现有的。现在,您将在X,Y,Z列中获得所需的数据。再次循环显示它们并以您需要的格式显示。

答案 1 :(得分:0)

决定为此尝试VBA代码。这有点尴尬,但完成工作。

采用快捷方式制作列b和c数字而不是字符串。您可以在电子表格上执行查找功能以进行转换,或在代码中添加额外的检查。

Sub find_high_values()
' subroutine to find max values of columns b and c against names
' assumes for simplicity that there are no more than 10 rows
' assumes values being checked to be numbers, if they are strings, additional loops would need to be done
Dim sName(10) As String, lBval(10) As Long, lCval(10) As Long 'arrays for original list
Dim iCountN As Integer, iUnique As Integer, iUniqueCount As Integer 'counters
Dim bUnique As Boolean
Dim rStart As Range, rOutput As Range 'ranges on worksheet
Dim lBmax(10) As Long, lCmax(10) As Long, sUniqueName(10) As String 'output arrays

Set rStart = ActiveSheet.Range("d6") 'Cell immediately above the first name in list
Set rOutput = ActiveSheet.Range("j6") 'cell reference for max value list
iUniqueCount = 1
For iCountN = 1 To 10 'set max counters to a min value
    lBmax(iCountN) = 0
    lCmax(iCountN) = 0
Next

For iCountN = 1 To 10 'step through each original row
    sName(iCountN) = rStart.Offset(iCountN, 0).Value
    lBval(iCountN) = rStart.Offset(iCountN, 1).Value
    lCval(iCountN) = rStart.Offset(iCountN, 2).Value
    bUnique = True 'Starter value, assume the name to be unique, changes to false if already in list
    For iUnique = 1 To iCountN 'loop to check if it is a new name
        If sUniqueName(iUnique) = sName(iCountN) Then bUnique = False
    Next
    If bUnique Then 'if new name, add to list of names
        sUniqueName(iUniqueCount) = sName(iCountN)
        iUniqueCount = iUniqueCount + 1
    End If
Next
iUniqueCount = iUniqueCount - 1 'make the count back to total number of names found
For iUnique = 1 To iUniqueCount 'loop through names
    For iCountN = 1 To 10 'loop through all values
        If sName(iCountN) = sUniqueName(iUnique) Then
            If lBval(iCountN) > lBmax(iUnique) Then lBmax(iUnique) = lBval(iCountN)
            If lCval(iCountN) > lCmax(iUnique) Then lCmax(iUnique) = lCval(iCountN)
        End If
    Next
Next

'output section
rStart.Resize(1, 3).Select
Selection.Copy
rOutput.PasteSpecial xlPasteValues

For iUnique = 1 To iUniqueCount
    rOutput.Offset(iUnique, 0).Value = sUniqueName(iUnique)
    rOutput.Offset(iUnique, 1).Value = lBmax(iUnique)
    rOutput.Offset(iUnique, 2).Value = lCmax(iUnique)
 Next

End Sub