[已解决]谢谢snrvgbb 老师。关于替换的需求

lhj323323 · 发表于 2011-11-7 14:04

本帖最后由 lhj323323 于 2011-11-8 12:08 编辑

老师：
上传的附件中有详细的说明，敬请看看，谢谢了
=========
是否无法设置最佳答案了？

最佳答案

月排行榜 / 总排行榜

snrvgbb

2011-11-8 10:04

Private Sub CommandButton1_Click()
Dim arr, k%, c As Range, matchs, match
arr = Sheets("数据源").Range("a1:a" & Sheets("数据源").[a65536].End(3).Row)
With CreateObject("vbscript.regexp")
.Global = True
.IgnoreCase = True
.Pattern = "Color\w+"
For k = 1 To UBound(arr)
If Len(arr(k, 1)) Then
If .Test(arr(k, 1)) Then
Set matchs = .Execute(arr(k, 1))
For Each match In matchs
Set c = Sheets("参数").Range("b:c").Find(match, , , 1)
If Not c Is Nothing Then
If c.Column = 2 Then
If Len(c.Offset(, 1)) Then
arr(k, 1) = Replace(arr(k, 1), match, c.Offset(, 1))
Else
arr(k, 1) = arr(k, 1) & "{★}"
End If
End If
Else
arr(k, 1) = arr(k, 1) & "{新增色彩}"
Sheets("参数").Range("a65536").End(3).Offset(1, 1) = match
End If
Next
End If
End If
Next
End With
With Sheets("结果表")
.Cells.ClearContents
.[a1].Resize(UBound(arr), 1) = arr
End With
End Sub

复制代码

跳转到最佳答案楼层

爱疯 · 发表于 2011-11-7 17:01

当关键词的整个“单词”位于参数表的B列，C列没有对应的关键词，那么接下来：

是先处理？（处理方法：进行说明，并用大括号括起来）
还是先判断？（判断整个“单词”是否位于参数表的C列）

liuguansky · 发表于 2011-11-7 17:22

{:091:}有趣的问题，等下来处理。

lhj323323 · 发表于 2011-11-7 18:57

爱疯发表于 2011-11-7 17:01
当关键词的整个“单词”位于参数表的B列，C列没有对应的关键词，那么接下来：

是先处理？（处理方法：进 ...

爱疯老师：
当关键词的整个“单词”位于参数表的B列，C列没有对应的关键词，那么接下来：

是先处理？（处理方法：进行说明，并用大括号括起来）
还是先判断？（判断整个“单词”是否位于参数表的C列）

==================================
应是先判断它是否在C列，如果没有在C列，再进行处理。

snrvgbb · 发表于 2011-11-7 19:02

Private Sub CommandButton1_Click()
Dim arr, k%, c As Range, matchs, match
arr = Sheets("数据源").Range("a1:a" & Sheets("数据源").[a65536].End(3).Row)
With CreateObject("vbscript.regexp")
.Global = True
.IgnoreCase = False
.Pattern = "Color\w+"
For k = 1 To UBound(arr)
If Len(arr(k, 1)) Then
If .Test(arr(k, 1)) Then
Set matchs = .Execute(arr(k, 1))
For Each match In matchs
Set c = Sheets("参数").Range("b:c").Find(match, , , 1)
If Not c Is Nothing Then
If c.Column = 2 Then
If Len(c.Offset(, 1)) Then
arr(k, 1) = Replace(arr(k, 1), match, c.Offset(, 1))
Else
arr(k, 1) = arr(k, 1) & "{★}"
End If
End If
End If
Next
End If
End If
Next
End With
With Sheets("结果表")
.Cells.ClearContents
.[a1].Resize(UBound(arr), 1) = arr
End With
End Sub
有些题意不是很明白，比如找不到的怎么表示

复制代码

lhj323323 · 发表于 2011-11-7 22:32

snrvgbb 发表于 2011-11-7 19:02

snrvgbb老师：
您提出的找不到怎么办，是我大意了，如找不到，则将这个新出现的单词导入到[参数]表的B列，同时在数据源的该句的最后添加一个{新增色彩}
比如
COUNT(SK>=SD,3) AND REF(LOW,1)=LLV(LOW,120),1,0),LOW*0.98,'买进') ,COLOR0099FF;{新增色彩}
同时在参数表的B列添加这个新增的色彩的代码：COLOR0099FF

snrvgbb · 发表于 2011-11-8 10:04

这个最佳答案由 snrvgbb 给出，感谢 snrvgbb 的回答。

单击隐藏图章

Private Sub CommandButton1_Click()
Dim arr, k%, c As Range, matchs, match
arr = Sheets("数据源").Range("a1:a" & Sheets("数据源").[a65536].End(3).Row)
With CreateObject("vbscript.regexp")
.Global = True
.IgnoreCase = True
.Pattern = "Color\w+"
For k = 1 To UBound(arr)
If Len(arr(k, 1)) Then
If .Test(arr(k, 1)) Then
Set matchs = .Execute(arr(k, 1))
For Each match In matchs
Set c = Sheets("参数").Range("b:c").Find(match, , , 1)
If Not c Is Nothing Then
If c.Column = 2 Then
If Len(c.Offset(, 1)) Then
arr(k, 1) = Replace(arr(k, 1), match, c.Offset(, 1))
Else
arr(k, 1) = arr(k, 1) & "{★}"
End If
End If
Else
arr(k, 1) = arr(k, 1) & "{新增色彩}"
Sheets("参数").Range("a65536").End(3).Offset(1, 1) = match
End If
Next
End If
End If
Next
End With
With Sheets("结果表")
.Cells.ClearContents
.[a1].Resize(UBound(arr), 1) = arr
End With
End Sub

复制代码

lhj323323 · 发表于 2011-11-8 12:09

snrvgbb 发表于 2011-11-8 10:04

snrvgbb 老师：
测试成功了，谢谢您。

杨帆远航 · 发表于 2011-11-8 16:33

学习了,学习了,看不懂

		自动登录	找回密码
密码			注册

[已解决]谢谢snrvgbb 老师。关于替换的需求

浏览过的版块