用VBA查找相同的字符串标颜色

RUIHUI-VIP · 发表于 2014-5-24 17:14

C:\Documents and Settings\SMT-VIP\桌面\测试\用VBA查找相同的字符串标颜色.bmp工程师等级试题,大家帮忙写个VBA代码
要的效果:
         1       用表格sheet2的A列数值在表格sheet1的F列查找,并标红色
      2       用表格sheet3的A列数值在表格sheet1的F列查找,并标绿色
      提示:把字符分隔符考虑进去可精确查找字符

RUIHUI-VIP · 发表于 2014-5-24 17:33

wzsy2_mrf · 发表于 2014-5-24 17:38

写个伪码给你：
arr1=sheet1.F
arr2=sheet2.A
arr3=sheet.A
for i=5 to iEnd(自己去确定）
for j=1 to iEnd2
      if arr2(j) 在 arr1(i)中（如用instr函数） then 标红色(要快一点可先不标，把地址记下来，最后一次性处理)
next
  .......
  对arr3同样处理不过标绿色
next

kenask · 发表于 2014-5-24 19:46

本帖最后由 kenask 于 2014-5-24 19:55 编辑

Sub test()
Dim d As Object, arr, x As Long, y As Long, n As Long, z As Byte, str, icell As Range, nrow As Long
Application.ScreenUpdating = False
For x = 2 To Sheets.Count
nrow = Sheets(x).Range("a65536").End(xlUp).Row
arr = Sheets(x).Range("a1:a" & nrow)
Set d = CreateObject("scripting.dictionary")
For y = 1 To UBound(arr)
d(arr(y, 1)) = ""
Next y
n = Range("f65536").End(xlUp).Row
For y = 5 To n
Set icell = Cells(y, "f")
str = Split(icell, ",")
For z = 0 To UBound(str)
If d.exists(str(z)) Then
icell.Characters(Start:=InStr(icell.Value, str(z)), Length:=Len(str(z))).Font.Color = Choose(x - 1, -16776961, -11489280)
End If
Next z
Next y
Next x
Application.ScreenUpdating = True
End Sub

复制代码

查找相同的字符串标颜色.rar (38.37 KB, 下载次数: 103) 试着写了一下。。。。。

RUIHUI-VIP · 发表于 2014-5-27 21:50

本帖最后由 RUIHUI-VIP 于 2014-5-29 14:16 编辑

很好,谢谢你.你的水平可以达到副主任工程师的级别了.

还有两个问题请教老师:
问题1:object对象字典工作表怎样改为sheet4?我把按钮改到sheet4了,(object工作表可以取消转为指定工作表吗?)
问题2:F列字典中有空值会报错,怎样跳过空值? (有没必要把空值先转为空格值?最好不用这种方法啦)

d = CreateObject("scripting.dictionary")

yf_home · 发表于 2014-5-27 22:31

不错，关注一下。

jimcomputer · 发表于 2014-5-27 22:34

刚入门，看不太懂

RUIHUI-VIP · 发表于 2014-5-28 21:21

kenask 发表于 2014-5-24 19:46
试着写了一下。。。。。

很好,谢谢你.还有个问题需请教的,回来

kenask · 发表于 2014-5-28 23:48

RUIHUI-VIP 发表于 2014-5-27 21:50
很好,谢谢你.你的水平可以达到副主任工程师的级别了.

Sub test()
Dim d As Object, arr, x As Long, y As Long, n As Long, z As Byte, str, nrow As Long
Application.ScreenUpdating = False
For x = 4 To Sheets.Count '从第四张表开始查找
nrow = Sheets(x).Range("a65536").End(xlUp).Row
arr = Sheets(x).Range("a1:a" & nrow)
Set d = CreateObject("scripting.dictionary")
For y = 1 To UBound(arr)
d(arr(y, 1)) = ""
Next y
n = Sheet2.Range("f65536").End(xlUp).Row
For y = 5 To n
With Sheet2.Cells(y, "f")
If Len(.Value) Then
str = Split(.Value, ",")
For z = 0 To UBound(str)
If d.exists(str(z)) Then
.Characters(Start:=InStr(.Value, str(z)), Length:=Len(str(z))).Font.Color = Choose(x - 3, -16776961, -11489280)
End If
Next z
End If
End With
Next y
Next x
Application.ScreenUpdating = True
End Sub

复制代码

RUIHUI-VIP · 发表于 2014-5-29 14:14

kenask 发表于 2014-5-28 23:48

谢谢老师,经典的代码,想给你鲜花的,可不知道怎么操作.

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

[已解决] 用VBA查找相同的字符串标颜色

评分