ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E问E答 > Excel VBA > 如何根据条件替换相应字符并求和[对重复或不符进行友好提示]？

如何根据条件替换相应字符并求和[对重复或不符进行友好提示]？

作者：绿色风 分类： 时间：2022-08-17 浏览：126
楼主
liuguansky		 Q：如何根据条件替换相应字符并求和[对重复或不符进行友好提示]？
“输入”表中列A、B中代码与金额一一对应，并以逗号分隔。
希望能按规则表将代码替换为中文（以顿号分隔），并按相应倍率将B列各金额求和，显示在“输出”表中。
A：用如下代码可以实现：
  1. Sub justtest()
  2.     Dim d, ar1, i&, k&, ar2, a1, a2, j&, str1$
  3.     Set d = CreateObject("scripting.dictionary")
  4.     With Sheets("规则")
  5.         k = .Cells(.Rows.Count, 1).End(3).Row - 1
  6.         ar1 = .Cells(2, 1).Resize(k, 3).Value
  7.         For i = 1 To k
  8.             If ar1(i, 1) <> "" Then
  9.                 If d.exists(ar1(i, 1)) Then
  10.                     MsgBox "规则中有重复代码，请核实": Exit Sub
  11.                     Else: d.Add CStr(ar1(i, 1)), i
  12.                 End If
  13.             End If
  14.         Next i
  15.     End With
  16.     With Sheets("输入")
  17.         k = .Cells(.Rows.Count, 1).End(3).Row - 1
  18.         ar2 = .Cells(2, 1).Resize(k, 2).Value
  19.         ReDim arrt(1 To k, 1 To 2)
  20.         For i = 1 To k
  21.             a1 = Split(ar2(i, 1), ","): a2 = Split(ar2(i, 2), ",")
  22.             If UBound(a1) <> UBound(a2) Then
  23.                 MsgBox "输入表中代码与金额不对应，请核实。": Exit Sub
  24.             End If
  25.             ar2(i, 2) = 0
  26.             For j = 0 To UBound(a1)
  27.                 str1 = Trim(a1(j))
  28.                 If d.exists(str1) Then
  29.                     If ar1(d(str1), 2) = "" Then
  30.                         ar2(i, 1) = Replace(ar2(i, 1), IIf(j = 0, "", ",") & a1(j), "")
  31.                         Else: ar2(i, 1) = Replace(ar2(i, 1), IIf(j = 0, "", ",") & a1(j), _
  32.                             IIf(j = 0, "", ",") & ar1(d(str1), 2))
  33.                     End If
  34.                     ar2(i, 2) = ar2(i, 2) + ar1(d(str1), 3) * a2(j)
  35.                     Else: MsgBox "输入表中的代码在规则表中没有，请添加。": Exit Sub
  36.                 End If
  37.             Next j
  38.         Next i
  39.     End With
  40.     Range("a2:b" & Rows.Count).ClearContents
  41.     Cells(2, 1).Resize(k, 2) = ar2
  42.     Set d = Nothing
  43. End Sub
2楼
eliane_lei		 进来学习！谢谢分享！
3楼
亡者天下		 过来学习一下

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap