[已解决]关于如何实现单击单元格输入汉字首字母自动弹出下拉菜单显示相应汉字选项

zg051sxy

老师首先非常感谢你的到来,我这有一段代码,要实现的是有两个表,名称分别是"封面","数据库""封面"的H9单元格实现输入汉字首字母后出现下拉菜单显示相应汉字."数据库"的"F列"和"G列"分别输入"汉字","对应首字母拼音"如下有两段代码我改如何实现:
下面的代码是flash的原代码
汉字转拼音函数及应用.rar (19.41 KB, 下载次数: 213)

2011-7-22 11:52 上传

点击文件名下载附件
汉字转拼音函数及应用
下面的表格是我想实现的
想实现的表格.zip (89.03 KB, 下载次数: 238)

2011-7-22 13:29 上传

点击文件名下载附件
想实现的表格
代码一是为了实现汉字转换拼音:

Option Compare Text
Function PY(ByVal rng As Range)
    Dim i%, k%, str$
    str = Replace(Replace(rng, " ", ""), "　", "")
    For i = 1 To Len(str)
        k = 1
        Do Until Mid("八嚓哒妸发旮铪讥讥咔垃妈拿哦妑七然仨他哇哇哇夕丫匝咗", k, 1) > Mid(str, i, 1)
            k = k + 1
        Loop
        PY = PY & Chr(64 + k)
    Next
End Function


代码二

Private Sub CommandButton1_Click()
    With CommandButton1
        If .Caption = "启用" Then
            .Caption = "禁用"
            TextBox1.Visible = False
            ListBox1.Visible = False
        Else
            .Caption = "启用"
        End If
    End With
End Sub


Private Sub ListBox1_Click()
    ActiveCell = Split(ListBox1, ".")(1)
    TextBox1.Visible = False
    ListBox1.Visible = False
End Sub

Private Sub TextBox1_Change()
    Dim rng As Range, Sh As Worksheet
    Dim str$, i As Byte, j As Byte, k As Byte
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    str = TextBox1
    If str = " " Or str = "　" Then
        TextBox1.Visible = False
        ListBox1.Visible = False
        Exit Sub
    End If
    If Len(str) = 1 Then
        If IsNumeric(str) Then Exit Sub
    ElseIf IsNumeric(Right(str, 2)) Then
        If Len(str) = 2 Then
            k = CInt(str)
            str = ""
        Else
            k = Right(str, 2)
            str = Left(str, Len(str) - 2)
        End If
    End If
    Set Sh = Sheets("名册")
    i = 1
    ListBox1.Clear
    For Each rng In Sh.Range("B1", Sh.[B65536].End(3))
        If rng Like UCase("*" & str & "*") Then
            Dic(i) = rng.Offset(, -1)
            ListBox1.AddItem Format(i, "00.") & rng.Offset(, -1)
            i = i + 1
        End If
    Next
    If k > 0 Then
        ActiveCell = Dic(k)
        Dic.RemoveAll
        TextBox1.Visible = False
        ListBox1.Visible = False
    End If
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        ListBox1.Visible = False
        TextBox1.Visible = False
        ActiveCell(2).Select
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CommandButton1.Caption = "禁用" Then Exit Sub
    If Target.Column > 1 Or Target.Row = 1 Or Target.Cells.Count > 1 Then
        ListBox1.Visible = False
        TextBox1.Visible = False
        Exit Sub
    End If
    With TextBox1
        .Activate
        .Visible = True
        .Value = ""
        .Top = Target.Top
        .Left = Target.Left
        .Width = Target.Width + 20
        .Height = Target.Height
    End With
    With ListBox1
        .Visible = True
        .Top = Target.Offset(1).Top
        .Left = Target.Left
        .Width = Target.Width + 20
        .Height = Target.Height * 10
    End With
End Sub

最佳答案

月排行榜 / 总排行榜

QLZ0602

2011-7-22 14:30

回复 zg051sxy 的帖子

汉字转拼音函数及应用.rar (64.84 KB, 下载次数: 740)

2011-7-22 14:30 上传

点击文件名下载附件
这样对不对?

跳转到最佳答案楼层

QLZ0602

没看懂什么意思. 最好把你要实现的结果也做成附件发上来

mayans

学习了.....

zg051sxy

回复 QLZ0602 的帖子

你好  我把想实现的表格发到上面了

zg051sxy

回复 zg051sxy 的帖子

就没人帮帮我啊

zg051sxy

回复 QLZ0602 的帖子

高手你是如何定义到H9单元格的,如果我随便定义到G9该如何操作呢?高手谢谢你

QLZ0602

回复 zg051sxy 的帖子

汉字转拼音函数及应用.rar (64.84 KB, 下载次数: 740)

2011-7-22 14:30 上传

点击文件名下载附件
这样对不对?

zg051sxy

回复 QLZ0602 的帖子

对的 高手 你是怎么弄的 能教教我么 可以加你QQ么 ?我的413502680

QLZ0602

QQ 695982239

QLZ0602

晚上QQ聊
现在我下班了