字典(Dictionary)习题: 如何编写双向查找函数

兰色幻想

 为了让大家了解和掌握字典的使用,特设置了两个小练习.

 完成的跟贴贴出代码.

练习题:

 

字典(Dictionary)视频讲解地址

http://www.excelpx.com/forum.php?mod=viewthread&tid=28445

[此贴子已经被作者于2007-10-8 21:23:24编辑过]

HGH

我先试试啦，请指正：

Public Function mycha(ByVal rng As Range)
    Dim d As New Dictionary
        For i = 2 To 7
            d.Add Cells(i, 2).Value, Cells(i, 1)
        Next i
    mycha = d(rng.Value)
    Set d = Nothing
End Function

Public Function mycha1(ByVal rng As Range)
    Dim d As New Dictionary
    Dim a
        For i = 2 To 7
            d.Add Cells(i, 2).Value, Cells(i, 1)
        Next i
    a = d(rng.Value)
    Set d = Nothing
        For i = 2 To 7
            d.Add Cells(i, 1).Value, Cells(i, 2)
        Next i
    If a = "" Then a = d(rng.Value)
    mycha1 = a
    Set d = Nothing
End Function

Luckyguy2008

Function mycha(ByVal Code As Range) As String
      Dim Dict, i As Long
      Set Dict = CreateObject("Scripting.Dictionary")
      With Sheet1
            For i = 2 To 7
                  Dict.Add .Cells(i, 2).Value, .Cells(i, 1).Value
            Next i
      End With
      mycha = Dict(Code.Value)
      Set Dict = Nothing
End Function

Function Mycha1(ByVal ID As Range)
      Dim Dict, i As Long
      Set Dict = CreateObject("Scripting.Dictionary")
      With Sheet1
            For i = 2 To 7
                  Dict.Add .Cells(i, 1).Value, .Cells(i, 2).Value
                  Dict.Add .Cells(i, 2).Value, .Cells(i, 1).Value
            Next i
      End With
      Mycha1 = Dict(ID.Value)
      Set Dict = Nothing
End Function

[此贴子已经被作者于2007-10-8 22:35:16编辑过]

兰色幻想

呵呵,很好

[em01]

djyjysxxs

试试：

Public Function mycha(ByVal rng As Range)
    Dim ds As New Dictionary
    arr1 = Sheet1.Range("a2:b7")
        For i = 1 To 6
            ds(arr1(i, 2)) = arr1(i, 1)
        Next i
    mycha = ds(rng.Value)
    Set ds = Nothing
End Function

Public Function mycha1(ByVal rng As Range)
    Dim ds As New Dictionary
    arr1 = Sheet1.Range("a2:b7")
    If WorksheetFunction.IsNumber(rng) Then
        For i = 1 To 6
            ds(arr1(i, 2)) = arr1(i, 1)
        Next i
        mycha1 = ds(rng.Value)
    Else
       For i = 1 To 6
          ds(arr1(i, 1)) = arr1(i, 2)
       Next i
       mycha1 = ds(rng.Value)
    End If
    Set ds = Nothing
End Function

借用3楼，将函数2改成：

Public Function mycha1(ByVal rng As Range)
    Dim ds As New Dictionary
    arr1 = Sheet1.Range("a2:b7")
    For i = 1 To 6
            ds(arr1(i, 2)) = arr1(i, 1)
            ds(arr1(i, 1)) = arr1(i, 2)
    Next i
    mycha1 = ds(rng.Value)
    Set ds = Nothing
End Function

[此贴子已经被作者于2007-10-9 10:19:42编辑过]

uranus1997

搞了半天，终于弄到我想要的效果了，无论变量为单元格引用还是直接的字符串，都可以算出结果
Option Explicit
Dim d As Object
'----------------------------------------------------------------------------
Sub dir()
Dim rng As Range
Dim rrow As Integer
rrow = ThisWorkbook.Sheets("sheet1").[A65536].End(xlUp).Row
Set d = CreateObject("Scripting.Dictionary")

For Each rng In ThisWorkbook.Sheets("sheet1").Range("B2:B" & rrow)
    d.Add rng.Value, rng.Offset(0, -1).Value
Next

For Each rng In ThisWorkbook.Sheets("sheet1").Range("A2:A" & rrow)
    d.Add rng.Value, rng.Offset(0, 1).Value
Next

End Sub
'----------------------------------------------------------------
Function Mycha1(y As Variant) As Variant
On Error Resume Next
 dir
 Select Case TypeName(y)
    Case "Range"
        Mycha1 = d.Item(CStr(y))
        Mycha1 = d.Item(CDbl(y))
        Exit Function
    Case Else
        Mycha1 = d.Item(y)
    End Select
Set d = Nothing
End Function

[此贴子已经被作者于2007-10-10 18:14:34编辑过]

liu007

呵呵，我来试一下，请兰版指教。

Function MyCha(r As Range)
   Dim dic As Object
   Set dic = CreateObject("scripting.dictionary")
   For i = 2 To 7
      dic.Add CStr(Sheets("sheet1").Cells(i, 2)), CStr(Sheets("sheet1").Cells(i, 1))
   Next i
   rs = CStr(r.Value)
   MyCha = dic(rs)
   Set dic = Nothing
End Function

Function MyCha1(r As Range)
   Dim dic As Object
   Set dic = CreateObject("scripting.dictionary")
   For i = 2 To 7
      dic.Add CStr(Sheets("sheet1").Cells(i, 2)), CStr(Sheets("sheet1").Cells(i, 1))
      dic.Add CStr(Sheets("sheet1").Cells(i, 1)), CStr(Sheets("sheet1").Cells(i, 2))
   Next i
   rs = CStr(r.Value)
   MyCha1 = dic(rs)
   Set dic = Nothing
End Function

zsd5237

学习

mxg825

七窍通了六窍！[em06]

zhj1978