检索代码优化

koala219

  要求：
L列输入需要时，M列出现对应的公司名。
M列输入公司名（可以不全），L列出现序号，M列出现公司全名。

基本可以实现，但代码会出现卡顿，求大神出手优化。
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim MK%, Arr, Brr, i!, j!
   Application.EnableEvents = True
If Target.Row < 3 Then Exit Sub
If Target.Column <> 12 And Target.Column <> 13 Then Exit Sub
If Target.Count > 1 Then Exit Sub
   Select Case Target.Column
      Case 12
         
                     MK = 500
          Arr = Sheet5.Range("A1:B500")
          For i = 1 To 500
             If Arr(i, 1) = Target Then Target.Offset(, 1) = Arr(i, 2)
          Next i
      Case 13
          MK = 500
          Arr = Sheet5.Range("A1:B500")
          If Target <> "" Then
          For j = 1 To MK
             If InStr(Arr(j, 2), Target) Then Target.Offset(, 0) = Arr(j, 2): Target.Offset(, -1) = Arr(j, 1): Exit For
          Next j
          End If
     Case Else
    End Select
End Sub

zpy2

循环500次就卡了，不会吧。。。。

yech20

我觉得你这个应该是输入后,进入了死循环~

qingc0221

L列输入时触发M列输入,M列输入时触发L列输入.......

muyuangan

Target 不能是两列，这样会陷入死循环。判断条件，要么删掉13，要么删掉12列。

YZC51

请参考
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MK%, Arr, Brr, i!, j!
    Application.EnableEvents = True
    If Target.Row < 3 Then Exit Sub
    If Target.Column <> 12 And Target.Column <> 13 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target > 500 And Target.Column = 12 Then Target = 500: Exit Sub
    Arr = Sheet5.Range("A1:B500")
    If Target.Column = 12 Then
        If Arr(Target, 1) = Target Then Target.Offset(, 1) = Arr(Target, 2)
    ElseIf 13 Then
        For j = 1 To 500
            If Arr(j, 2) = Target.Value Then Target.Offset(, -1) = Arr(j, 1)
        Next j
    End If
End Sub

YZC51

优化下
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MK%, Arr, Brr, i!, j!
    If Target.Row < 3 Then Exit Sub
    If Target.Column <> 12 And Target.Column <> 13 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target > 500 And Target.Column = 12 Then Target = 500: Exit Sub
    Arr = Sheet5.Range("A1:B500")
    If Target.Column = 12 Then
        If Arr(Target, 1) = Target Then Target.Offset(, 1) = Arr(Target, 2): Exit Sub
    ElseIf 13 Then
        For j = 1 To 500
            If Arr(j, 2) = Target.Value Then Target.Offset(, -1) = Arr(j, 1): Exit Sub
        Next j
    End If
End Sub

YZC51

满足要求不？
L列输入需要时，M列出现对应的公司名。
M列输入公司名（可以不全），L列出现序号，M列出现公司全名。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MK%, Arr, Brr, i!, j!
    If Target.Row < 3 Then Exit Sub
    If Target.Column <> 12 And Target.Column <> 13 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target > 500 And Target.Column = 12 Then Target = 500: Exit Sub
    Arr = Sheet5.Range("A1:B500")
    If Target.Column = 12 Then
        If Arr(Target, 1) = Target Then Target.Offset(, 1) = Arr(Target, 2): Exit Sub
    Else
        For j = 1 To 500
            If InStr(Arr(j, 2), Target) Then Target.Offset(, -1) = Arr(j, 1): Exit Sub
        Next j
    End If
End Sub

大灰狼1976

M列输入公司名称的一部分，如果是唯一的话就没问题，如果不是唯一怎么处理？比如输入“集团”？

YZC51

请参考
需要输入3个字符
世界500强.zip (34.26 KB, 下载次数: 2)

2019-5-30 21:22 上传

点击文件名下载附件