双击某单元格，提取指定记录，谢谢Qs18和quqiyuan、liulang0808、ykcbf1100老师！

lhj323323 · 发表于 2024-9-29 06:39

本帖最后由 lhj323323 于 2024-9-29 14:05 编辑

老师：

附件里，有写好的语句
想实现如下效果
双击B列的某个单元格，提取所有指定记录到EF列
但老是会把不相关的记录提取出来

如下图

求助.rar (14.48 KB, 下载次数: 9)

快照4.png

老师如有空，请帮忙看看，先谢谢了
顺祝节日快乐！

Qs18 · 发表于 2024-9-29 07:07

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) '双击操作
Dim Myr As Long
Dim arr1, arr2
Application.ScreenUpdating = False
If Target.Column = 2 Then '限第2列
Cancel = True
Myr = Range("a65536").End(xlUp).Row
arr1 = Range("a2:b" & Myr).Value '
ReDim arr2(1 To UBound(arr1), 1 To 2)
For x = 1 To UBound(arr1)
If Target.Value = arr1(x, 2) And Target.Offset(0, -1) = arr1(x, 1) Then '怎么改都不对
'If InStr(Target.Value, arr1(x - 1, 2)) > 0 Then
r = r + 1
For j = 1 To 2
arr2(r, j) = arr1(x, j)
Next
End If
Next
End If
[e2:f65536] = ""
[e2].Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
Application.ScreenUpdating = True
End Sub

复制代码

Qs18 · 发表于 2024-9-29 07:08

试试.........

Qs18 · 发表于 2024-9-29 07:09

试试........

quqiyuan · 发表于 2024-9-29 07:16

lhj323323 · 发表于 2024-9-29 07:22

Qs18 发表于 2024-9-29 07:09
试试........

谢谢老师

If Target.Value = arr1(x, 2) And Target.Offset(0, -1) = arr1(x, 1) Then
标红这段，是何意啊？

左边那部分，原来是不能用InStr函数

lhj323323 · 发表于 2024-9-29 07:38

quqiyuan 发表于 2024-9-29 07:16

看了你们两位老师的意见
原来是我搞复杂了，以为必须使用instr函数

多谢老师！
问题解决了。

liulang0808 · 发表于 2024-9-29 08:11

。。。。。。。。。。。

ykcbf1100 · 发表于 2024-9-29 08:39

本帖最后由 ykcbf1100 于 2024-9-29 08:41 编辑

参与一下，用字典

ykcbf1100 · 发表于 2024-9-29 08:42

参与一下。。。

		自动登录	找回密码
密码			免费注册

[已解决] 双击某单元格，提取指定记录，谢谢Qs18和quqiyuan、liulang0808、ykcbf1100老师！