最新进展：任意字符的输入逐步提示（超强功能）

疯狂土豆神

学习了，谢谢。

JSYZGOOD

学习了，谢谢。

yes363001640

真是厉害啊，一直觉得vba不能实现逐步提示的。学习了。

471472156

zjdh 发表于 2014-10-8 18:10

能否说明一下，代码的意思，谢谢

471472156

zjdh 发表于 2014-10-8 18:10

因为时间比较长，或许我怎么发您原来文件，然后再指教一下？

471472156

zjdh 发表于 2014-10-8 18:10

大侠，能否回复一下，关于您论坛上的往来结算文件，（输入时高效提示信息），盼望指教一下。
QQ471472156     感谢感谢

zjdh

471472156 发表于 2020-6-16 14:50
大侠，能否回复一下，关于您论坛上的往来结算文件，（输入时高效提示信息），盼望指教一下。
QQ47147215 ...

你哪儿看不懂？

471472156

zjdh 发表于 2020-6-17 14:38
你哪儿看不懂？

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    R = Selection.Row
    If Selection.Column = 15 Then
        Cells(R, "G") = ListBox1.List(ListBox1.ListIndex, 0)
        Cells(R, "N") = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(R, "O") = ListBox1.List(ListBox1.ListIndex, 2)
    Else
        Cells(R, "H") = ListBox1.List(ListBox1.ListIndex, 0)
        Cells(R, "R") = ListBox1.List(ListBox1.ListIndex, 1)
        Cells(R, "S") = ListBox1.List(ListBox1.ListIndex, 2)
        Cells(R, "T") = ListBox1.List(ListBox1.ListIndex, 3)
        Cells(R, "M") = ListBox1.List(ListBox1.ListIndex, 4)
        Cells(R, "P") = ListBox1.List(ListBox1.ListIndex, 5)
        Cells(R, "Q") = ListBox1.List(ListBox1.ListIndex, 6)
    End If
    Me.ListBox1.Clear
    Me.TextBox1 = ""
    Me.ListBox1.Visible = False
    Me.TextBox1.Visible = False
    ActiveCell.Offset(1, 0).Select
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim I, J, R
    Dim Language As Boolean, ARR As Variant
    Dim myStr As String
    With Me.ListBox1
        .Clear
        With Me.TextBox1
            For I = 1 To Len(.Value)
                If Asc(Mid$(.Value, I, 1)) > 255 Or Asc(Mid$(.Value, I, 1)) < 0 Then
                    Language = True
                    myStr = myStr & Mid$(.Value, I, 1)
                Else
                    myStr = myStr & LCase(Mid$(.Value, I, 1))
                End If
            Next
        End With
        If Selection.Column = 15 Then
            ARR = Sheets("单位编码").Range("A2:E" & Sheets("单位编码").Range("A65536").End(3).Row)
            .Column() = Application.Transpose(Array("单位编码", "单位类", "单位名称"))
            If Language Then
                w = 3
            Else
                w = 5
            End If
            For I = 1 To UBound(ARR)
                If InStr(LCase(ARR(I, 1)) & ARR(I, w), myStr) Then
                    R = ListBox1.ListCount
                    .AddItem
                    .List(R, 0) = ARR(I, 1)
                    .List(R, 1) = ARR(I, 2)
                    .List(R, 2) = ARR(I, 3)
                End If
            Next
        Else
            ARR = Sheets("物料编码").Range("A2:H" & Sheets("物料编码").Range("A65536").End(3).Row)
            .Column() = Application.Transpose(Array("物料编码", "品名", "型号", "规格", "", "", ""))
            If Language Then
                w = 2
            Else
                w = 8
            End If
            For I = 1 To UBound(ARR)
                If InStr(LCase(ARR(I, 1)) & ARR(I, w), myStr) Then
                    R = ListBox1.ListCount
                    .AddItem
                    For J = 1 To 7
                        .List(R, J - 1) = ARR(I, J)
                    Next
                End If
            Next
        End If
    End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I As Integer, ARR
    If Target.Count = 1 Then
        If Target.Column = 15 And Target.Row > 1 Then
            ARR = Sheets("单位编码").Range("A2:C" & Sheets("单位编码").Range("A65536").End(3).Row)
            With Me.TextBox1
                .Visible = True
                .Top = Target.Top - 1
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height + 2
                .Activate
            End With
            With Me.ListBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = Target.Width * 4.5
                .Height = Target.Height * 5
                .ColumnCount = 3
                .ColumnWidths = "50,50,80"
                .Column() = Application.Transpose(Array("单位编码", "单位类", "单位名称"))
                For I = 1 To UBound(ARR)
                    .AddItem
                    .List(I, 0) = ARR(I, 1)
                    .List(I, 1) = ARR(I, 2)
                    .List(I, 2) = ARR(I, 3)
                Next
            End With
        ElseIf Target.Column = 18 And Target.Row > 1 Then
            ARR = Sheets("物料编码").Range("A2:G" & Sheets("物料编码").Range("A65536").End(3).Row)
            With Me.TextBox1
                .Visible = True
                .Top = Target.Top - 1
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height + 2
                .Activate
            End With
            With Me.ListBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = Target.Width * 5.5
                .Height = Target.Height * 5
                .ColumnCount = 7
                .ColumnWidths = "50,50,50,50,0,0,0"
                .Column() = Application.Transpose(Array("物料编码", "品名", "型号", "规格", "", "", ""))
                For I = 1 To UBound(ARR)
                    .AddItem
                    For J = 1 To 7
                        .List(I, J - 1) = ARR(I, J)
                    Next
                Next
            End With
        Else
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
        End If
    End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With TextBox1
        Select Case KeyCode
        Case 27    'Esc
            TextBox1.Visible = False
            ListBox1.Visible = False
            Selection.Select
        Case 38    '向上
            ActiveCell.Offset(-1, 0).Select
        Case 40    '向下
            ActiveCell.Offset(1, 0).Select
        End Select
    End With
End Sub

您这个《往来结算》真的太强大了，
不要脸的提一个小细节：就是像有的文字，转出来的拼音首个字母不对，譬如“黄”字。
之后，这些代码，如果可以注释一下就好了，通俗易懂的解释，另

471472156

zjdh 发表于 2020-6-17 14:38
你哪儿看不懂？

里面强大的代码，看不懂

zjdh

471472156 发表于 2020-6-18 12:10
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    R = Selection.Row
    I ...

是的，有些文字转出来的拼音首字母不对，例：喉、管、箍....，那是由于原来是在XP系统，到了WIN7环境，由于字库原因，需要修改拼音自定义函数。
Public Function LChin(Str As String) As Variant
    On Error Resume Next
    Str = StrConv(Str, vbNarrow)
    If Asc(Str) > 0 Or Err.Number = 1004 Then LChin = ""
    LChin = WorksheetFunction.VLookup(Str, [{"啊","A";"芭","B";"擦","C";"搭","D";"蛾","E";"发","F";"噶","G";"哈","H";"击","J";"喀","K";"垃","L";"妈","M";"拿","N";"哦","O";"啪","P";"期","Q";"然","R";"撒","S";"塌","T";"挖","W";"昔","X";"压","Y";"匝","Z"}], 2)
End Function