Question

我想从数据表中找到一个很好的列表。我的数据看起来像这样

HospitalCode   Name    SHAK   Subdivision    Specialty1    Specialty2   Specialty3    Specialty4
1301           Rich    5435   Copenhagen     84            65
1301           Rich    4434   Heart med      91            44           22
1301           Rich    9944   Lung med       33                         99
1309           Bisp    4324   London         32
1309           Bisp    8483   GP             21            44                          22
...

依旧约4000行。我需要的是每个医院代码的输出和特定医院的所有独特专业的列表。像这样的东西

Hospital code    Specialty1     Specialty2    Specialty3 ... Specialty99
1301             84             65            91         ... 33
1309             32             21            44

选择Specialty99时，我需要所有与特定医院代码相关的专业。我试过vlookup，但自然这只是给了我第一个价值。我不明白sumproduct，但也许它可以在这里使用？所有的帮助都会受到极大的关注。祝你有愉快的一天。

Answer 1

我认为VBA可能是您最好的解决方案，因为数据透视表无法帮助找到多列的唯一值，如Spec1，Spec2等。

就VBA而言，这是非常基本的循环 - 唯一棘手的一点就是唯一性。为了解决这个问题，我使用了Collection对象 - 这些可以用来获取唯一值，因为它不会让你添加＆＃39;键的第二个副本。

此解决方案还假设您的数据按HOSPITAL_CODE排序（从您的示例中看起来如此）。如果没有，请在运行此代码之前对其进行排序

这是一个有效的sample workbook

Sub makeTable()

    Dim rngHospId As Range
    Dim rngSpec As Range
    Dim listOfSpecs As New Collection
    Dim hosp As Range
    Dim spec As Range
    Dim wsOut As Worksheet

    'Settings - change these for your situation
    Set wsData = Worksheets("Data")
    Set rngHospId = wsData.Range("A2:A7") ' Single column with Hosp IDs
    Set rngSpec = wsData.Range("B2:F7") 'All columns with Specialties

    'Create new Worksheet for output
    Set wsOut = Worksheets.Add(After:=wsData)
    wsOut.Range("A1") = "Enter Headers Here ..."

    'Process each row
    outRow = 2 'row to print to in output
    For i = 1 To rngHospId.Cells.Count
        Set hosp = rngHospId(i, 1)
        'Add every specialty from the current row
        For Each spec In Intersect(rngSpec, hosp.EntireRow)
            If spec.Value <> "" Then
                On Error Resume Next
                    'Entries will only be added if unique
                    listOfSpecs.Add spec.Value, CStr(spec.Value)
                On Error GoTo 0
            End If
        Next spec

        'If last row for a hospital, output the final list of specs
        If rngHospId(i + 1).Value <> hosp.Value Then
            'Output
             wsOut.Cells(outRow, 1) = hosp.Value
             cnt = 0
            'Print all elements of collection
             For Each entry In listOfSpecs
                cnt = cnt + 1
                wsOut.Cells(outRow, 1 + cnt) = entry
             Next entry
            'Clear Collection
             Set listOfSpecs = Nothing
             Set listOfSpecs = New Collection
            'Move to next row
             outRow = outRow + 1
        End If
    Next i

End Sub

Answer 2

您可以使用SUMIF创建此项，只需为总计创建一个新选项卡。

我已在以下链接上传了一个基本示例：

here

在Excel中匹配多个值

2 个答案: