请用VBA编个程序, 要求如下

[复制链接]
查看11 | 回复1 | 2011-4-11 12:39:20 | 显示全部楼层 |阅读模式
1. 在B栏查找以\"600\"defds123\"601\"defds123\"700\"开头的单元格B(i),找到一个符合条件的B(i)后,在5行处插入一行, 将此B(i)各C(i)复制到A5和B5,将G(i)设公式为“=C5”并加底色
2. 继续查找,找到后同以上操作(往下插入行)。如有重复者,不插入新行,只将其G(i)设公式为“=C(x)”并加底色,如B21和B32同为600254,B32时仅将G32加公式,不再在上方插入新行。
注: 程序只处理G列,不能对其它单元格产生影响。程序要考虑符合项多的情况.即实际可能有更多的行。
http地址://是hotfile.是com/dl/是113999745/是c31bd3a/是123.xls.是html是
请去掉中文字,下载EXCEL档案, 无奈之举。
回复

使用道具 举报

千问 | 2011-4-11 12:39:20 | 显示全部楼层
<pre id=\"best-answer-content\" class=\"reply-text mb10\">主要是处理 重复符合项 时的公式不好写:
----------
Public Sub sss()

Dim s$: s = \"P/N\" \'定位数据的标题行
Dim sA: sA = Array(\"600\", \"601\", \"700\") \'对比的数据
Dim c1$: c1 = \"B\" \'对比数据的列
Dim c2$: c2 = \"C\" \'需要复制的列
Dim c3$: c3 = \"G\" \'需要写入公式的列
Dim rC vbOK Then Exit Sub

Else

n = n 1: m = m 1

ss = ssvbOK Then Exit Sub

End If

Exit For

End If

Next
Next
MsgBox \"已完成!\" defds123 Chr(10) defds123 Chr(10) defds123 _

\"共找到 \" defds123 m defds123 \" 个数据,\" defds123 Chr(10) defds123 _

\"共插入 \" defds123 n defds123 \" 行。\"
End Sub
回复

使用道具 举报

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

本版积分规则

主题

0

回帖

4882万

积分

论坛元老

Rank: 8Rank: 8

积分
48824836
热门排行