返回目录：excel表格制作
你的情况只能用自定义函数e799bee5baa6e79fa5e98193e78988e69d83333来实现,
在工作表窗口按ALT+F11 弹出VBA编辑窗口,然后再弹出窗口的左边的列表栏点击鼠标右键选插入模块,粘贴下面的代码到右边的编辑窗口:
自定义函数的使用 和内置函数相同
本自定义函数的名称:mylookup
用法:
mylookup(条件1,条件2,数据区域,返回第几列数据)
说明:条件1为完全匹配,条件2,是包含,数据区域参考vlookup的数据区域规则,返回第几列数据 也参看vlookup用法)
代码如下:
Function mylookup(T1, T2, Rng, col)
Dim dic
arr = Rng.Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
dic(arr(i, 1)) = i
Next
For Each d In dic.keys
a = dic(T1)
If T1 = d And T2 Like "*" & arr(dic(d), 2) & "*" Then aaa = arr(dic(d), col)
Next
If aaa <> "" Then
mylookup = aaa
Else
mylookup = "N/A"
End If
End Function
给你个例子
答：完全按照你的图示，我写了段程序，测试结果正确。
Sub ScoreQuery()
Dim Orng As Range
Dim ObjRng As Range
Dim C As Range
Dim FirstAddress As String
Dim Cnt As Long
Set Orng = Sheets("Sheet1").Range("A2")
Orng.Offset(-1, 1).Resize(1, 2) = Array("科目", "成绩")
With Sheets("Sheet2")
Set ObjRng = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
Do Until IsEmpty(Orng)
Cnt = Application.CountIf(ObjRng, Orng.Value)
If Cnt = 0 Then
Set Orng = Orng.Offset(1, 0)
Else
Set C = ObjRng.Find(what:=Orng.Value, LookIn:=xlValues, lookat:=xlPart)
FirstAddress = C.Address
If Cnt > 1 Then
Range(Orng.Offset(1, 0), Orng.Offset(Cnt - 1, 0)).EntireRow.Insert
Range(Orng, Orng.Offset(Cnt - 1, 0)).EntireRow.FillDown
End If
Do
Orng.Offset(0, 1) = C.Offset(0, 1)
Orng.Offset(0, 2) = C.Offset(0, 2)
Set Orng = Orng.Offset(1, 0)
Set C = ObjRng.FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
Loop
MsgBox "查询完毕！e799bee5baa6e997aee7ad94e59b9ee7ad94362", vbInformation, "提示"
End Sub
附件中的excel的作用是，将指定的某个打开的工作薄中的一张大表，按指定的一列中不同的关键字拆分到多个工作表，或是多个工作薄中。切记一点的是，需要拆分的工作表，要打开着。否则会出错。
以下所说的关键字，其实就是指定区域所含的不重复单元格。
说明：1、点击上面的按钮后，首选要输入需要拆分的工作表所在的工作薄名字，可以是本
工作薄名字，也可以是其他打开的工作薄的名字，这个要看你想拆分的工作表具
体在哪个工作薄中了，记住要包含工作薄的后缀名。
2、第二步请输入第一步中指定工作薄中需要拆分的工作表的名称。
3、第三步，请输入需要拆分的工作表中拆分依据所在的列号。
4、第四步，请输入需要拆分的工作表中拆分依据开始的行号。
5、第五步，请输入需要拆分的工作表中拆分依据结束的行号。
以上5步要填的内容，可以事先填在本表H1到H5的单元格中。
6、第六步，需要选择是只拆分指定的关键字，还是将拆分依据中所有的关键字都拆
分。如果需要指定关键字拆分，那么就会弹出选择关键字的对话框。如果所e799bee5baa6e4b893e5b19e334选择
的关键字在依据区域全都没有，刚会提示是否需要重新选择。如果所选择的关键
字中只有一部分在依据区域中有，那么只拆分在拆分依据中的有关键字。
7、如果第六步，关键字选择完毕，那么第七步就需要选择是拆分到源工作薄的新建
工作表中，还是拆分到源工作薄所在目录下面的新建工作薄中。如果选择拆分到
源工作薄的新建工作表中，那么就会先删除源工作薄中以关键字命名的工作表，
然后再将拆分的各个工作表以关键字命名。如果选择拆分到新建工作薄中，那么
接下来要选择新建工作薄命名方式，然后再选择工作表的命名方式。
8、最后一点，如果要只拆分部分关键字，那么关键字一定要事先写在该工薄中，否
则没法取得关键字。不管是拆分部分关键字还是全部关键字，关键字所在单元格
不能是用公式得到的字符。
ps:总表中拆分依据所在列的内容最好为纯文本，不要用公式。并且如果要拆分的大表中如果有很多公式，打开很慢的话，建议先在大表中把公式计算模式改为手动计算。
嗯，可以，发文件给我看看，
另：你想用代码，连点财富值，都不出么？