在Excel中匹配多个值
问题描述:
我想从数据表中获得一个不错的列表。我的数据看起来像这样在Excel中匹配多个值
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,但也许它可以在这里使用? 所有帮助将大大appriciated。 祝您有愉快的一天。
答
我想VBA可能是你最好的解决方案,因为透视表不会帮助找到独特的价值在多个列,像Spec1,Spec2等
就VBA来说,这是非常基本的循环 - 唯一棘手的一点是唯一性。为了处理这个问题,我使用了一个Collection对象 - 这些可以用来获得唯一的值,因为它不会让你添加'key'的第二个副本。
该解决方案还假定您的数据按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
+0
谢谢!正如我想要的那样工作! –
用(VBA)脚本/宏这样做将需要相当长的一段时间/工作和复杂的算法。 – moffeltje
@moffeltje是的,我也这么认为。我曾希望有某种擅长的编码,可以替代执行。 –
我认为excel确实有一些工具可以用来使这个过程更快,但是你的案例非常具体。 – moffeltje