excel表查找相同并标记颜色，求一个VBA

Question

用sheet1、A列的名字一个一个去sheet2、G列查找包含sheet1、A列名字的如有则整行标记为红色，无不做标识，查找知道sheet1、A列为空白为止。
例如：sheet1、 A sheet2、 G
我是王五 李四
加法是李四 张三
结果
sheet1、 A 列中 加法是李四 整行标记为红色。其他不变，查找直到 sheet2、G为空白为止。
用sheet1、A列的名字一个一个去sheet2、G列查找包含sheet1、A列名字的如有则整行标记为红色，无不做标识，查找直到sheet1、A列为空白为止。
例如：sheet1、 A sheet2、 G
我是王五 李四
加法是李四 张三
结果
sheet1、 A 列中 加法是李四 整行标记为红色。其他不变，查找直到 sheet2、G为空白为止。只是举个例子，实际sheet1、 A 列有几千个数据， G列有几百个数据。

Answer 1

Sub 标记相同姓名()
Dim i As Long
Dim rng As Range
Dim XingMing As String
With Application
.ScreenUpdating = False
End With

Sheets("sheet1").Select
For i = 1 To Sheet1.UsedRange.Rows.Count
Sheets("sheet1").Select
XingMing = Cells(i, 1)
If XingMing <> "" And RmbJe <> "姓名" Then
On Error Resume Next
Sheets("sheet2").Select
Set rng = Sheet2.UsedRange.Find(what:=XingMing, lookat:=xlWhole)
If Not rng Is Nothing Then
Sheets("sheet1").Select
Rows(i).Select
With Selection
.Interior.Color = vbRed
End With
End If
End If
Next
With Application
.ScreenUpdating = True
End With
End Sub追问

不能用啊，颜色没有变啊，要2表中选出来的变色啊

追答

你把表发给我，我看看，[email protected]

追问

发过去了，麻烦了

追答

晕啊，这表跟你说的一点也不一样啊，难怪不变色

追问

语言组织能力不行..麻烦给个解法。

追答

你用这段代码，看看你要的是不是这个结果，不行再联系我
Sub 查找并标记相同姓名()
With Application
.ScreenUpdating = False
End With
For i = 2 To Sheet1.UsedRange.Rows.Count
Sheets("sheet1").Select
j = Cells(i, 1)
For p = 2 To Sheet2.UsedRange.Rows.Count
Sheets("失去诉讼时效").Select
k = Cells(p, 7)
If InStr(k, "" & j & "") 0 Then
Rows(p).Select
With Selection
.Interior.Color = vbRed
.Font.Color = vbYellow
End With
End If
Next
Next
With Application
.ScreenUpdating = True
End With
End Sub

追问

运行时错误 9
下标越界

Answer 2

Sub 标记相同姓名()
Dim i As Long
Dim rng As Range
Dim XingMing As String
With Application
.ScreenUpdating = False
End With

For i = 1 To Sheet2.UsedRange.Rows.Count
Sheets("sheet2").Select
XingMing = Cells(i, 7)
If XingMing <> "" Then
Sheets("sheet1").Select
Set rng = Cells.Find(What:=XingMing, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If Not rng Is Nothing Then
Rows(rng.Row).Select
With Selection
.Interior.Color = vbRed
End With
End If
End If
Next
With Application
.ScreenUpdating = True
End With
End Sub追问

大哥还是不行，

追答

我这里行的啊。2003版本 的。

追问

我的也是。估计我说的不怎么准确吧。上面的大哥说我说的和给他发的表就不是一个样。。。

追答

也发给我吧

Answer 3

VBA才行，先查找对应的，再设置颜色。

Answer 4

能否发图看看.
如果只是颜色问题,你可以在格式,条件格式中设置就行了.