[已解决]请教个查找的代码

东方智彩 · 发表于 2012-1-15 08:36

根据H列的编号查找HA1:HJ1中相同编号列中是否有B列此编号的3个相同数,如果有就在J列标示出来,
例H3是8,查HI列中没有605,J3显示"●"
例H4是1,查HB列中有069,J4显示"OK"
J列其它类推至最后一个空格,请教高手,谢谢!

Book1.rar (17.89 KB, 下载次数: 5)

雄鹰 · 发表于 2012-1-15 08:55

本帖最后由雄鹰于 2012-1-15 09:03 编辑

Sub 查找()
A = Timer
For i = 3 To [b65536].End(xlUp).Row
For j = 2 To [ha65536].End(xlUp).Row
   For k = 209 To 218
      If Cells(i, 2) = Cells(j, k) Then
         Cells(i, 10) = "OK"
         GoTo 100
      End If
   Next
Next
Cells(i, 10) = "●"
100:
Next
Debug.Print A - Timer
End Sub

查找11.JPG

东方智彩 · 发表于 2012-1-15 09:19

谢谢高手回复好快呀,测试代码有点慢,能否解决下速度?

sunjing-zxl · 发表于 2012-1-15 09:23

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

本帖最后由 sunjing-zxl 于 2012-1-15 09:24 编辑

Sub aa()
Dim arr, arr1, arr2, arr3
Dim i As Long, j As Long
Dim n As Long, m As Long
arr = Range("B3:B" & [A65536].End(xlUp).Row)
arr1 = Range("H3:H" & [A65536].End(xlUp).Row)
arr2 = Range("HA1:HJ" & [HA65536].End(xlUp).Row)
ReDim arr3(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
n = 0
For j = 2 To UBound(arr2)
If arr2(j, arr1(i, 1) + 1) = arr(i, 1) Then
n = n + 1
arr3(i, 1) = "OK"
Exit For
End If
Next j
If n = 0 Then
arr3(i, 1) = "●"
End If
Next i
Range("J3:J" & [J65536].End(xlUp).Row + 3).ClearContents
Range("J3").Resize(UBound(arr3), 1) = arr3
End Sub

复制代码

附件：

Book1-sunjing.rar (29.58 KB, 下载次数: 11)

东方智彩 · 发表于 2012-1-15 09:32

谢谢老师,高手啊,学习了

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

[已解决]请教个查找的代码

评分