[已解决]满足两条件提取文本

lidayu

恳请老师赐教，要如何实现满足条件提取文本，详情见附件，谢谢！
补充，如“汇总表”B与C列在“数据源”表满足不了条件则为空。
满足条件提取对应文本.rar (125.34 KB, 下载次数: 13)

2017-4-14 21:50 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-4-15 13:03

9774行开始有一些不完整数据，应该不能参与计算，我删掉了。
如果有需要请跟我说明一下使用规则。

另，跟currentregion没有关系，是由于你的工作表名变了，另外“大单位汇总”工作表添加了第一行数据。

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("数据源").[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   d(arr(i, 2) & "," & arr(i, 3)) = i
   
7. Next i
   
8. brr = Sheets("大单位汇总").[a2].CurrentRegion
   
9. For i = 3 To UBound(brr) - 2
   
10.   If brr(i, 3) <> "" Then brr(i, 1) = arr(d(brr(i, 2) & "," & brr(i, 3)), 1)
    
11. Next i
    
12. Sheets("大单位汇总").[a1].Resize(UBound(brr)) = Application.Index(brr, , 1)
    
13. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("数据源").[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   d(arr(i, 2) & "," & arr(i, 3)) = i
   
7. Next i
   
8. brr = Sheets("汇总表").[a2].CurrentRegion
   
9. For i = 2 To UBound(brr) - 2
   
10.   If brr(i, 3) <> "" Then brr(i, 1) = arr(d(brr(i, 2) & "," & brr(i, 3)), 1)
    
11. Next i
    
12. Sheets("汇总表").[a2].Resize(UBound(brr)) = Application.Index(brr, , 1)
    
13. End Sub

复制代码

lidayu

大灰狼1976 发表于 2017-4-14 22:13

您好，把代码复制到实际工作表后出现了“下标越界”9，呈上附件请您测试。 170414.rar (246.25 KB, 下载次数: 4)

2017-4-14 22:35 上传

点击文件名下载附件

大灰狼1976

你修改下赋值给数组的单元格区域就行了，我是只按提供的附件做的，不考虑其他情况，CURRENTREGION比较方便，但是必须根据实际情况进行替换。

lidayu

大灰狼1976 发表于 2017-4-14 22:52
你修改下赋值给数组的单元格区域就行了，我是只按提供的附件做的，不考虑其他情况，CURRENTREGION比较方便 ...

大灰狼1976 您好，我是菜鸟一个，能否请您根据我后来呈上的附件再修改下，非常感谢您！

大灰狼1976

9774行开始有一些不完整数据，应该不能参与计算，我删掉了。
如果有需要请跟我说明一下使用规则。

另，跟currentregion没有关系，是由于你的工作表名变了，另外“大单位汇总”工作表添加了第一行数据。

1. Sub aaa()
   
2. Dim arr, brr, i&, d As Object
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("数据源").[a1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.   d(arr(i, 2) & "," & arr(i, 3)) = i
   
7. Next i
   
8. brr = Sheets("大单位汇总").[a2].CurrentRegion
   
9. For i = 3 To UBound(brr) - 2
   
10.   If brr(i, 3) <> "" Then brr(i, 1) = arr(d(brr(i, 2) & "," & brr(i, 3)), 1)
    
11. Next i
    
12. Sheets("大单位汇总").[a1].Resize(UBound(brr)) = Application.Index(brr, , 1)
    
13. End Sub

复制代码

lidayu

大灰狼1976 发表于 2017-4-15 13:03
9774行开始有一些不完整数据，应该不能参与计算，我删掉了。
如果有需要请跟我说明一下使用规则。

您好，如果9774后面的数据不删可以吗，不够如果确需要删了才能的话这样也可以，非常感谢您的帮助!

大灰狼1976

不删也可以，但都是不完整的数据需要给个判断规则。
最好是从上到下没有空行，并且数据结构相同，这样行数再多也能计算，仅时间长短问题。

lidayu

大灰狼1976 发表于 2017-4-15 13:30
不删也可以，但都是不完整的数据需要给个判断规则。
最好是从上到下没有空行，并且数据结构相同，这样行数 ...

您好，那就用这样了，谢谢！

lidayu

大灰狼1976 发表于 2017-4-15 13:30
不删也可以，但都是不完整的数据需要给个判断规则。
最好是从上到下没有空行，并且数据结构相同，这样行数 ...

早上好，“数据源”表9774后面的数据我不删，能否请您再动动手帮我增加一个判断，要如何增加代码请您赐教，谢谢！