[已解决]再次求助老师和高手们两个查找和提取的代码

东方智彩 · 发表于 2012-3-12 10:09

求助老师和高手们两个查找和提取的代码,请帮助解决下,附件有详细说明,谢谢

Book1.rar (10.06 KB, 下载次数: 20)

东方智彩 · 发表于 2012-3-12 13:19

再说明下,查到了一个条件只显示对应的另一个就可以了,也有时是同时出现出个两个条件,只提取显示后面的条件对应的就可以了,
如 967
123 中有两个条件16和27,16---27,27--38,只要显示38就可以了

bb75308973 · 发表于 2012-3-12 14:42

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

单击隐藏图章

本帖最后由 bb75308973 于 2012-3-12 15:11 编辑

测试看看

Sub 第一题()
Dim n As Integer, i As Integer
Columns("O").Clear
n = Range("K65536").End(xlUp).Row
For i = 4 To n
If Range("M" & i) = Range("K" & (i + 1)) Then '判断
Range("O" & (i + 1)) = Format(Range("L" & (i + 1)) & Range("M" & (i + 1)), "00") '符合条件输出结果
End If
Next
End Sub

复制代码

Sub 第二题()
Dim n As Integer, i As Integer, x As Integer
Dim rg As Range, rg1 As Range
Dim arr(0 To 9)
Application.ScreenUpdating = False
Columns("AB").Clear
n = Range("X65536").End(xlUp).Row
On Error Resume Next
For i = 5 To n '从5开始这样就可以不用计算最后一行下面的那行没有数据的行
Set rg = Range(Range("X" & i), Range("Z" & (i - 1))) '设定下面要查找的范围
For x = 0 To 9 '查找0到9的每一个值,放到相应的数组里
Set rg1 = rg.Find(x, , , xlWhole)
If rg1 Is Nothing Then
arr(x) = "空" '如果查找不到的话默认会等于0,不利于判断,所以这里弄个标识"空"
Else
arr(x) = x
End If
Next
If arr(0) <> "空" And arr(5) <> "空" Then Range("AB" & i) = 16
If arr(1) <> "空" And arr(6) <> "空" Then Range("AB" & i) = 27
If arr(2) <> "空" And arr(7) <> "空" Then Range("AB" & i) = 38
If arr(3) <> "空" And arr(8) <> "空" Then Range("AB" & i) = 49
If arr(4) <> "空" And arr(9) <> "空" Then
Range("AB" & i).NumberFormat = "00"
Range("AB" & i) = 5
End If
Set rg = Nothing '养成习惯将对像清空,不然会影响下一个循环的结果
Set rg1 = Nothing
Next
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

复制代码

东方智彩 · 发表于 2012-3-12 17:16

谢谢高手解答，代码测试正确，只是第一题提取的数据能否再加个由小到大的排序，如63，排序显示为36

bb75308973 · 发表于 2012-3-12 18:53

东方智彩发表于 2012-3-12 17:16
谢谢高手解答，代码测试正确，只是第一题提取的数据能否再加个由小到大的排序，如63，排序显示为36

可以的
你装这条代码:Range("O" & (i + 1)) = Format(Range("L" & (i + 1)) & Range("M" & (i + 1)), "00")
改成:
if range("L"&(i+1))<range("M"&(i+1)) then
range("O"& (i+1))=Format(Range("L" & (i + 1)) & Range("M" & (i + 1)), "00")
else
range("O"& (i+1))= Format( Range("M" & (i + 1)) & Range("L" & (i + 1)) , "00")
end if

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

[已解决]再次求助老师和高手们两个查找和提取的代码

评分