[已解决][讨论]关于使用兰色幻想版主的EXCEL单元格联想输入时的奇怪问题

flying008

大大平安！

这是兰色的原贴链接：http://www.excelpx.com/dispbbs.asp?boardid=5&replyid=190808&id=31916&page=1&skin=0&Star=1

我的使用环境：Windows2000Pro_sp4 + Office2003sp3简体中文版本

首先感谢兰色版主的大作，可以让大家节约很多重复工作时间和学习到VBA，原文件直接打开使用是没有任何问题的，

但如果把Excel的显示比例调整到超过100%，例如110%, 120% , 130%, 150%，就会发现有一个问题：在文本框直接输入数字或字母时下面的智能筛选列表就会随着字符的增减而变得越来越长，越来越宽，这是一个很实际的问题。

另外在本论坛有一位贵宾写的同类功能的宏里也存在同样的问题，只有excel显示比例是100%时才是正常的。

请兰色版主在万忙之中能抽空出来指点一下是什么原因造成这样的问题？是Exel本身的Bug吗？如何才能根本解决这样的问题，从而保持下拉列表的长度和宽度不随着输入而变化？谢谢……

[此贴子已经被作者于2009-12-31 9:38:59编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2009-12-31 14:03

QUOTE:

以下是引用flying008在2009-12-31 13:34:00的发言：

非常感谢！经过您的建议，增加2行分别锁定列表长度和宽度的代码就解决了，谢谢！

但HYY514大大的同类功能的这个宏修改代码却仍然没有效果，请大大再指教……谢谢！

原贴链接：http://www.excelpx.com/forum.php?mod=viewthread&tid=25623  第2楼的自动输入宏.

这里有3个地方要加，看来这个.LIst的属性真的有些问题呢

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) '事件模糊匹配

Selection = TextBox1.Text

Dim arr, arr2(), i As Long, n As Long, zh As String
arr = Sheet1.[a2].Resize(Sheet1.[a65536].End(xlUp).Row - 1, 1)
zh = TextBox1.Text & "*"
For i = 1 To UBound(arr)
If arr(i, 1) Like zh Then
n = n + 1
ReDim Preserve arr2(1 To n)
arr2(n) = arr(i, 1)
End If
Next
If n > 0 Then
ListBox1.List() = WorksheetFunction.Transpose(arr2)
ListBox1.Visible = True
Else
ListBox1.List() = Array("")
End If
ListBox1.Width = 80
End Sub

Private Sub ListBox1_Click()
    TextBox1.Visible = False
    With Sheet2.ListBox1
         Selection = .Text
         .List = Array("")
         .Width = 80
         .Visible = False
    End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
    Dim ta As Range, taf As Range
    Set ta = Target: Set taf = Target.Offset(0, 1)
   With Sheet2.TextBox1
         .Left = ta.Left
         .Top = ta.Top
         .Height = ta.Height
         .Width = ta.Width
         .Activate
         .Text = ta
         .Visible = True
    End With
                        
    If Len(ta.Text) = 0 Then
         With Sheet2.ListBox1
                .Top = taf.Top
                .Visible = True
         End With
    Else
        With Sheet2.ListBox1
                .Visible = False
                .Top = taf.Top
         End With
    
    End If
                  
    If Len(ta.Text) = 0 Then Application.SendKeys "{BS}"
   
Else
    If Sheet2.TextBox1.Visible = True Then
      
        With Sheet2.TextBox1
             .Text = ""
             .Visible = False
        End With
   End If
    If Sheet2.ListBox1.Visible = True Then
        With Sheet2.ListBox1
            .List = Array("")
            .Width = 80
            .Visible = False
        End With
    End If
End If
End Sub

跳转到最佳答案楼层

amulee

这个很正常，显示比例调大了，那个下拉框也放大了啊。你要下拉框不变大，那个尺寸再除以显示比例就行了。

flying008

您好！

下拉列表框随着EXCEL显示比例的变化而变化是正常的，

但随着输入的字符增减变化而变化就不正常了，理论上就这个具体的VBA的Code预期目的来说，一定程度上无论Excel的显示比例如何，下拉列表的长度和宽度应该是不会随着输入的字符增减变化而变化！

[此贴子已经被作者于2009-12-31 10:03:40编辑过]

amulee

终于知道你的问题了，看了一下的确如此。还没来得及研究原因，先给你一个对策。加一句限定宽度的代码：

Private Sub TextBox1_Change()
On Error Resume Next
Me.ListBox1.Clear
Dim ARR, ARR1(), k As Integer, sss As String
ARR = Sheets("职员花名册").Range("A1:B936")
sss = Me.TextBox1.Text
ReDim ARR1(1 To UBound(ARR))
For X = 1 To UBound(ARR)
If Asc(sss) > 0 Then
 If ARR(X, 1) Like UCase(sss) & "*" Then
   k = k + 1
   ARR1(k) = ARR(X, 2)
 End If
Else
   If ARR(X, 2) Like sss & "*" Then
   k = k + 1
   ARR1(k) = ARR(X, 2)
 End If
End If
Next X
k = 0
Me.ListBox1.Width = 89.25
Me.ListBox1.List = ARR1
End Sub

flying008

====以上代码略过……

Next X
k = 0

Me.ListBox1.Height = 150

Me.ListBox1.Width = 120
Me.ListBox1.List = ARR1
End Sub

增加了红色的这2行代码，可以在输入字符时限制长度和宽度，但……

1－当显示比例为130%或150%时，点击文本框时所出现的默认下拉列表宽度非常大，没有受到代码约束！

2－显示比例超过100%时，假如在文本框内输入错误而使用Backspace回退键后，下拉列表宽度和长度也会变得越来越大，没有受到代码约束！[假如文本框内输入abc共3位字符，而使用键盘的Backspace键达到4次及以上次数时，[敲击键盘的Backspace键次数 > 文本框输入的字符数] 问题就出现了！]

非常感谢2楼大大的指点，只是问题还是没有根本解决，因为根本原因也没有找到！

[此贴子已经被作者于2009-12-31 10:49:06编辑过]

amulee

改变一下代码结构，经测试是由于Me.ListBox1.List = ARR1惹的祸。以下代码经测试未发现你所述情况。

Me.ListBox1.List = ARR1

Me.ListBox1.Width = 89.25
End Sub

[此贴子已经被作者于2009-12-31 12:25:41编辑过]

flying008

非常感谢！经过您的建议，增加2行分别锁定列表长度和宽度的代码就解决了，谢谢！

但HYY514大大的同类功能的这个宏修改代码却仍然没有效果，请大大再指教……谢谢！

原贴链接：http://www.excelpx.com/forum.php?mod=viewthread&tid=25623  第2楼的自动输入宏.

[此贴子已经被作者于2009-12-31 13:35:36编辑过]

amulee

QUOTE:

以下是引用flying008在2009-12-31 13:34:00的发言：

非常感谢！经过您的建议，增加2行分别锁定列表长度和宽度的代码就解决了，谢谢！

但HYY514大大的同类功能的这个宏修改代码却仍然没有效果，请大大再指教……谢谢！

原贴链接：http://www.excelpx.com/forum.php?mod=viewthread&tid=25623  第2楼的自动输入宏.

这里有3个地方要加，看来这个.LIst的属性真的有些问题呢

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) '事件模糊匹配

Selection = TextBox1.Text

Dim arr, arr2(), i As Long, n As Long, zh As String
arr = Sheet1.[a2].Resize(Sheet1.[a65536].End(xlUp).Row - 1, 1)
zh = TextBox1.Text & "*"
For i = 1 To UBound(arr)
If arr(i, 1) Like zh Then
n = n + 1
ReDim Preserve arr2(1 To n)
arr2(n) = arr(i, 1)
End If
Next
If n > 0 Then
ListBox1.List() = WorksheetFunction.Transpose(arr2)
ListBox1.Visible = True
Else
ListBox1.List() = Array("")
End If
ListBox1.Width = 80
End Sub

Private Sub ListBox1_Click()
    TextBox1.Visible = False
    With Sheet2.ListBox1
         Selection = .Text
         .List = Array("")
         .Width = 80
         .Visible = False
    End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target.Count = 1 Then
    Dim ta As Range, taf As Range
    Set ta = Target: Set taf = Target.Offset(0, 1)
   With Sheet2.TextBox1
         .Left = ta.Left
         .Top = ta.Top
         .Height = ta.Height
         .Width = ta.Width
         .Activate
         .Text = ta
         .Visible = True
    End With
                        
    If Len(ta.Text) = 0 Then
         With Sheet2.ListBox1
                .Top = taf.Top
                .Visible = True
         End With
    Else
        With Sheet2.ListBox1
                .Visible = False
                .Top = taf.Top
         End With
    
    End If
                  
    If Len(ta.Text) = 0 Then Application.SendKeys "{BS}"
   
Else
    If Sheet2.TextBox1.Visible = True Then
      
        With Sheet2.TextBox1
             .Text = ""
             .Visible = False
        End With
   End If
    If Sheet2.ListBox1.Visible = True Then
        With Sheet2.ListBox1
            .List = Array("")
            .Width = 80
            .Visible = False
        End With
    End If
End If
End Sub

结冰的鱼

不过也挺大声 。。,大家都说硬盘有声，不过我的超级安静， 贴着耳朵才听见转的声音 ，估计是我运气好吧 。

flying008

ListBox1.List() = WorksheetFunction.Transpose(arr2)

ListBox1.Height = 100 '此处也要增加代码限制高度

ListBox1.Width = 80　 '此处也要增加代码限制宽度
ListBox1.Visible = True
Else
……

谢谢大大的指教！经过以上4处代码的增加，才能真正有效的控制List列表因显示比例影响下在输入时造成的非预期变化问题！[已经测试, 但出现这个问题的原因还是没有找到]

另还想请教大大：ListBox1.Height = 100和 Me.ListBox1.Height = 100有什么区别?

[此贴子已经被作者于2010-1-2 14:45:34编辑过]