Board logo

標題: [分享] 一对多查询 [打印本頁]

作者: 198188    時間: 2012-11-13 15:12     標題: 一对多查询

[attach]13112[/attach][attach]13112[/attach]資料庫
姓名        时间        参赛项目
张大亮        2/5/2010        田径
陈星        2/5/2010        田径
柳香香        2/5/2010        田径
张大亮        3/5/2010        跳水
赵大年        3/5/2010        跳水
刘星星        3/5/2010        跳水
张大亮        4/5/2010        滑冰
朱丽丽        4/5/2010        滑冰
赵大年        4/5/2010        滑冰
刘倩倩        5/5/2010        兵乓
吴芳华        5/5/2010        兵乓

VBA 後
查询对象        参赛项目        时间
张大亮        田径        2/5/2010
        跳水        3/5/2010
        滑冰        4/5/2010
               
'声明函数Look,类型为String.包括四个参数,前两个为必选参数,后两个为可选参数
Function look(查找值 As String, 区域 As Range, Optional 列 As Integer = 2, Optional 索引号 As Integer = 1) As String
  Application.Volatile  '声明为易失性函数
  Dim i As Long, cell As Range, Str As String
  With 区域.Columns(1)  '引用区域的第一列
    '如果引用区域第一个单元格等于查找的对象,那么将该单元格赋予变量Cell。否则使用Find方法查找,将找到的单元格赋予变量Cell
    If .Cells(1) = 查找值 Then Set cell = .Cells(1) Else Set cell = .Find(查找值, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then  '如果找到
      Str = cell.Address  '记录单元格地址
      Do              '通过循环继续查找
        i = i + 1  '累加变量
        '如果变量等于最后一个参数,那么将查找到的单元格右边的值赋予Look函数
        If i = 索引号 Then look = cell.Offset(0, 列 - 1): Exit Function
        Set cell = 区域.Find(查找值, cell, , xlWhole)  '查找下一个
      Loop While cell.Address <> Str
    Else
      look = ""  '如果找不到则直接返回空白
    End If
  End With
End Function
作者: 幻影水藍色    時間: 2016-5-4 13:28

真可惜 等級不夠




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)