[已解决]谢谢sliang28老师。跨列提取包含单一指定关键词的所有记录

lhj323323 · 发表于 2013-8-21 08:58

本帖最后由 lhj323323 于 2013-8-21 11:03 编辑

老师：

跨列提取包含指定关键词的所有记录

在上传的附件中有详细的说明，请老师看看，先谢谢了

提取单一标准的记录.rar (48.04 KB, 下载次数: 13)

lyf7276 · 发表于 2013-8-21 09:51

你第一次点公司，查找到的华能，把华能的数据复制到表三，假如你第二次点公司，还是要复制华能的数据吗？

lhj323323 · 发表于 2013-8-21 09:53

lyf7276 发表于 2013-8-21 09:51
你第一次点公司，查找到的华能，把华能的数据复制到表三，假如你第二次点公司，还是要复制华能的数据吗？

当我第二次点公司时，结果表的数据，除了标题行之外，其余内容已清空了。

lyf7276 · 发表于 2013-8-21 10:00

意思是你第一次点公司时，得到的是浦发银行的数据。你第二次点公司时，你是想得到哪的数据？是随机抽取性质为公司的数据，还是按顺序抽取，还是公司就只点一次了，以后再也不点了？

lhj323323 · 发表于 2013-8-21 10:15

本帖最后由 lhj323323 于 2013-8-21 10:17 编辑

lyf7276 发表于 2013-8-21 10:00
意思是你第一次点公司时，得到的是浦发银行的数据。你第二次点公司时，你是想得到哪的数据？是随机抽取性质 ...

我每一次双击一个单元格时，就是一次全新的操作，每一次操作提取的是【全部】符合条件的数据，都是导入到结果表的第二行起。

意思是第一次点公司时，得到的是浦发银行的数据。当我第二次点公司时，如果浦发银行的数据仍然符合提取条件，就肯定要再次提取它，因为我第二次点公司时，原有的结果表数据已清空了,
不是随机抽取性质为公司的数据，是按顺序抽取，
sheet1表中的数据是可以重复点的。

suye1010 · 发表于 2013-8-21 10:31

这个最佳答案由 suye1010 给出，感谢 suye1010 的回答。

单击隐藏图章

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr0, i, j, k, Tempvalue, arr
arr0 = Sheets("数据源").Range("B2:V407")
ReDim arr(1 To UBound(arr0), 1 To UBound(arr0, 2))
For i = 1 To UBound(arr0)
For j = 3 To UBound(arr0, 2) Step 3
If Replace(arr0(i, j), " ", "") = Replace(Target.Value, " ", "") Then
Tempvalue = Tempvalue + 1
For k = 1 To UBound(arr0, 2)
arr(Tempvalue, k) = arr0(i, k)
Next k
Exit For
End If
Next j
Next i
Sheets("结果表").Range("B2:V407") = arr
Range("A1").Select
End Sub

复制代码

lyf7276 · 发表于 2013-8-21 10:48

你看是这样的吗？

lhj323323 · 发表于 2013-8-21 10:48

suye1010 发表于 2013-8-21 10:31

老师：

不好意思，现在通过其它途径验证出有点不对

我以提取[资产管理公司]为例，按您写的语句，一共提取了五个公司，而实际上是应有15家公司，比如上海机杨、沧州大化等

lhj323323 · 发表于 2013-8-21 11:06

lyf7276 发表于 2013-8-21 10:48
你看是这样的吗？

老师，您的版本高了哈，我打不开，能否将语句直接贴出来？

lyf7276 · 发表于 2013-8-21 11:08

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 Then
xinzi = Target.Value
m = Sheets(3).Cells(Rows.Count, 2).End(xlUp).Row
Sheets(3).Rows("2:" & m + 1).Delete
n = Sheets(2).Cells.Find("*", , , , , xlPrevious).Row
For i = 2 To n
If Application.WorksheetFunction.IsError(Application.Match(xinzi, Sheets(2).Rows(i), 0)) = False Then
x = Sheets(3).Cells.Find("*", , , , , xlPrevious).Row
Sheets(2).Rows(i).Copy Sheets(3).Range("a" & x + 1)
End If
Next
End If
End Sub

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

[已解决]谢谢sliang28老师。跨列提取包含单一指定关键词的所有记录

点评