[已解决]求助个提取两码差条件的代码

东方智彩

如何从A列中提取符合H2、I2、J2中条件的显示到CA列,请高手指教,谢谢
码差提取.rar (13.46 KB, 下载次数: 27)

2012-1-17 17:28 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2012-1-17 20:56

东方智彩 发表于 2012-1-17 20:38
谢谢爱疯版主，提取正确，能否将提取的紧密显示，去掉CA列中间的空行

1. 
   
2. Sub tq()
   
3.     Dim A(), B, C, i&, j&, s&
   
4. 
   
5.     With Sheets("sheet1")
   
6.         i = .Range("a2").End(xlDown).Row
   
7.         A = .Range("a2:a" & i).Value
   
8.         ReDim C(1 To UBound(A), 1 To UBound(A, 2))
   
9. 
   
10.         For i = 1 To UBound(A)
    
11.             B = Split(A(i, 1), " ")
    
12.             If B(2) - B(0) = 2 Or B(3) - B(0) = 3 Or B(4) - B(0) = 7 Then
    
13.                 s = s + 1
    
14.                 For j = 0 To 4
    
15.                     C(s, 1) = C(s, 1) & Format(B(j), "00") & " "
    
16.                 Next j
    
17.             End If
    
18.         Next i
    
19. 
    
20.         .Range("ca2:ca65536").ClearContents
    
21.         .Range("ca2").Resize(s, 1) = C
    
22.     End With
    
23. End Sub

复制代码

跳转到最佳答案楼层

sunjing-zxl

没搞懂                       

东方智彩

如A2中的1 2 3 4 5
用第5位减第1位的差等于7，用第4位减第1位的差等于3，用第3位减第1位的差等于2的就提取显示到CA列。
5-1=4，4-1=3，3-1=2，有一个条件符合要求了就提取显示到CA列

爱疯

1. 
   
2. Sub tq()
   
3.     Dim A(), i&, j&, B
   
4. 
   
5.     With Sheets("sheet1")
   
6.         i = .Range("a2").End(xlDown).Row
   
7.         A = .Range("a2:a" & i).Value
   
8.     End With
   
9.     For i = 1 To UBound(A)
   
10.         B = Split(A(i, 1), " ")
    
11.         A(i, 1) = ""
    
12.         If B(2) - B(0) = 2 Or B(3) - B(0) = 3 Or B(4) - B(0) = 7 Then
    
13.             For j = 0 To 4
    
14.                 A(i, 1) = A(i, 1) & Format(B(j), "00") & " "
    
15.             Next j
    
16.         End If
    
17.     Next i
    
18.     Sheets("sheet1").Range("ca2").Resize(UBound(A), 1) = A
    
19. End Sub

复制代码

这样吗{:041:}

东方智彩

谢谢爱疯版主，提取正确，能否将提取的紧密显示，去掉CA列中间的空行

爱疯

东方智彩 发表于 2012-1-17 20:38
谢谢爱疯版主，提取正确，能否将提取的紧密显示，去掉CA列中间的空行

1. 
   
2. Sub tq()
   
3.     Dim A(), B, C, i&, j&, s&
   
4. 
   
5.     With Sheets("sheet1")
   
6.         i = .Range("a2").End(xlDown).Row
   
7.         A = .Range("a2:a" & i).Value
   
8.         ReDim C(1 To UBound(A), 1 To UBound(A, 2))
   
9. 
   
10.         For i = 1 To UBound(A)
    
11.             B = Split(A(i, 1), " ")
    
12.             If B(2) - B(0) = 2 Or B(3) - B(0) = 3 Or B(4) - B(0) = 7 Then
    
13.                 s = s + 1
    
14.                 For j = 0 To 4
    
15.                     C(s, 1) = C(s, 1) & Format(B(j), "00") & " "
    
16.                 Next j
    
17.             End If
    
18.         Next i
    
19. 
    
20.         .Range("ca2:ca65536").ClearContents
    
21.         .Range("ca2").Resize(s, 1) = C
    
22.     End With
    
23. End Sub

复制代码

东方智彩

谢谢爱版主，太棒了，学习！