ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: cartel

[求助] 请教老师,用VBA找出相对应数的和值,并显示在其它列,谢谢!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-7-26 15:07 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 陈永生 于 2023-7-26 15:09 编辑

已经测试可以实现你的目的



  1. Function total(ParamArray num())
  2.     Dim j
  3.     For Each ar In num
  4.        For Each a In ar
  5.         j = j + Int(a)
  6.        Next
  7.     Next
  8.     total = j
  9. End Function


  10. Sub test()
  11.     '将j2单元格写入数组
  12.     Dim arr_a
  13.     arr_a = Split(Range("j2"), ",")
  14.    
  15.     '将o列数据循环处理
  16.     Dim i As Long, arr_b, x, y, w
  17.     For i = 1 To Cells(Rows.Count, 15).End(xlUp).Row
  18.         arr_b = Split(Cells(i, 15), ",")
  19.         x = total(arr_b) 'o列单元格数据求和
  20.         For y = 0 To UBound(arr_a)
  21.             If x = Int(arr_a(y)) Then
  22.                 w = w + 1
  23.                 Cells(w, "p") = Cells(i, "o")
  24.                 Cells(w, "r") = arr_a(y)
  25.             End If
  26.         Next y
  27.     Next i
  28. End Sub
复制代码


请教老师,用VBA找出相对应数的和值,并显示在其它列,谢谢!.zip

18.08 KB, 下载次数: 0

TA的精华主题

TA的得分主题

发表于 2023-7-26 15:20 | 显示全部楼层
测试了下 可以实现你的要求

3用VBA找出相对应数的和值,并显示在其它列,谢谢!.zip

20.1 KB, 下载次数: 0

TA的精华主题

TA的得分主题

发表于 2023-7-26 16:09 | 显示全部楼层
这题 根本用不到字典
111.png

TA的精华主题

TA的得分主题

发表于 2023-7-26 16:10 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 perfect131 于 2023-7-26 20:06 编辑
  1. Sub kong()
  2.     arr = [o1:o9]
  3.     a = "," & [j2] & ","
  4.     ReDim ar(1 To UBound(Split(a, ",")) - 1, 1 To 3)
  5.     For i = 1 To UBound(arr)
  6.         If Len(arr(i, 1)) Then
  7.             aa = Evaluate(Replace(arr(i, 1), ",", "+"))
  8.             If Len(a) = 0 Then Exit For
  9.             If InStr(1, a, "," & aa & ",") Then
  10.                 j = j + 1
  11.                 ar(j, 1) = arr(i, 1)
  12.                 ar(j, 3) = aa
  13.                 Replace a, "," & aa & ",", ""
  14.             End If
  15.         End If
  16.     Next
  17.     [p1].Resize(j, 3) = ar
  18. End Sub
复制代码

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

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-17 07:52 , Processed in 0.026161 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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