Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 6418|回复: 6

[已解决]VBA某一列单元格出现符合条件的提取后面的数字

[复制链接]
发表于 2014-3-20 20:57 | 显示全部楼层 |阅读模式
5学分
B列中出现符合条件的字符就把相应后面的数值相加到另外个单元格里
最佳答案
2014-3-21 19:51
………………

样品3.rar

2.28 KB, 下载次数: 42

最佳答案

查看完整内容

Sub tt() r = .End(3).Row arr = Range("a2:d" & r) r1 = .End(3).Row brr = Range("i2:j" & r1) For i = 1 To UBound(brr) For k = 2 To UBound(arr) If InStr(arr(k, 2), brr(i, 1)) > 0 Then brr(i, 2) = brr(i, 2) + arr(k, 4) Next Next Range("i2:j" & r1) = brr End Sub
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2014-3-20 20:57 | 显示全部楼层
Sub tt()
    r = [b65536].End(3).Row
    arr = Range("a2:d" & r)
    r1 = [i65536].End(3).Row
    brr = Range("i2:j" & r1)
    For i = 1 To UBound(brr)
        For k = 2 To UBound(arr)
            If InStr(arr(k, 2), brr(i, 1)) > 0 Then brr(i, 2) = brr(i, 2) + arr(k, 4)
        Next
    Next
    Range("i2:j" & r1) = brr
End Sub

样品3.rar

9.05 KB, 下载次数: 86

回复

使用道具 举报

 楼主| 发表于 2014-3-20 20:58 | 显示全部楼层
设置一个按钮,一点击就会自动算出来
回复

使用道具 举报

发表于 2014-3-21 19:49 | 显示全部楼层
  1. Sub Macro1()
  2. Dim arr, brr, d, i&
  3. Set d = CreateObject("scripting.dictionary")
  4. arr = Range("a3:d" & Range("a65536").End(xlUp).Row)
  5. brr = Range("i2").CurrentRegion
  6. For i = 2 To UBound(arr)
  7.     d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 4)
  8. Next
  9. For i = 1 To UBound(brr)
  10.     brr(i, 1) = d(brr(i, 1))
  11. Next
  12. Range("j2").Resize(UBound(brr)) = brr
  13. End Sub
复制代码
回复

使用道具 举报

发表于 2014-3-21 19:51 | 显示全部楼层    本楼为最佳答案   
………………

样品3.zip

8.1 KB, 下载次数: 129

回复

使用道具 举报

 楼主| 发表于 2014-3-22 18:42 | 显示全部楼层
dsmch 发表于 2014-3-21 19:51
………………

差不多这样了..谢谢!不过我里面是举例而已,名字不一样(我随便改了“个”变“啊”就不行了)......而且需要筛选出来的有很多,肯定不止三个。能否再帮我改下?就是我随便改下名字或条件都能把符合条件的筛选出来,I 列中添加条件也能够筛选出来
回复

使用道具 举报

发表于 2014-3-22 18:51 | 显示全部楼层
Sub Macro1()
Dim arr, brr, d, i&
Set d = CreateObject("scripting.dictionary")
arr = Range("a3:d" & Range("a65536").End(xlUp).Row)
brr = Range("i2").CurrentRegion
For i = 1 To UBound(arr)
    d(arr(i, 2)) = d(arr(i, 2)) + arr(i, 4)
Next
For i = 1 To UBound(brr)
    brr(i, 1) = d(brr(i, 1))
Next
Range("j2").Resize(UBound(brr)) = brr
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 14:58 , Processed in 0.557635 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表