[已解决]麻烦老师帮我看看这样的代码

love_liwu · 发表于 2015-7-27 15:19

本帖最后由 love_liwu 于 2015-7-27 22:42 编辑

Public Arr
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 6 Or Target.Row < 6 Then GoTo 100
Dim d, i&, kc
Set d = CreateObject("Scripting.Dictionary")
Arr = Sheet2.[F1].CurrentRegion
For i = 1 To UBound(Arr)
d(Arr(i, 1)) = ""
Next
kc = d.keys
'Target.Resize(1, 13).ClearContents
         With Me.TextBox1
            .Visible = True
            .Top = Target.Top
            .Left = Target.Left
            .Width = Target.Width
            .Height = Target.Height + 5
            .Activate
         End With
         With Me.ListBox1
            .Visible = True
            .Top = Target.Top
            .Left = Target.Left + Target.Width
            .Height = Target.Height * 10
         End With
         With Me.ListBox1
            .List = kc
         End With
         Exit Sub
100:
         Me.ListBox1.Clear
         Me.TextBox1 = ""
         Me.ListBox1.Visible = False
         Me.TextBox1.Visible = False

End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r1
ActiveCell.Value = ListBox1.Value
Me.ListBox1.Clear
Me.TextBox1 = ""
Me.ListBox1.Visible = False
Me.TextBox1.Visible = False
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer
Dim Language As Boolean
Dim myStr As String
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
With Sheet2
      Arr = .[F1].CurrentRegion
      If myStr = "" Then Exit Sub
      For i = 2 To UBound(Arr)
         If Language <> True Then
            dm = py(Arr(i, 1))
            If InStr(dm, myStr) > 0 Then
                  Me.ListBox1.AddItem Arr(i, 1)
            End If
         Else
            If InStr(Arr(i, 1), myStr) > 0 Then
                  Me.ListBox1.AddItem Arr(i, 1)
            End If
         End If
      Next
End With

End Sub

我的问题是：
优惠性质代码及名称（具体可在sheet2表找寻）这一列可根据实际情况增行，点击F6弹出文本框模糊搜索，假设有内容则在LISTBOX出现，双击LISTbox选项即可返回到F6。可以增行或减行，增行时候F7、F8等依次类推。无论是增行还是减行，F5和公司签章那个单元格不能出现搜索框。

最佳答案

月排行榜 / 总排行榜

zjdh

2015-7-27 18:45

顾客欠货款还款优惠备案登记表.rar (17.64 KB, 下载次数: 9)