[已解决]如何用代码提取想要的数据？

安妮妮

附件 提数附件.rar (136.15 KB, 下载次数: 19)

2016-4-24 20:54 上传

点击文件名下载附件

多谢了。

最佳答案

月排行榜 / 总排行榜

爱疯

2016-4-24 21:24

Sub Click()
    Dim A, B, i, j, k, x, s
    A = Sheets(1).Range("a1").CurrentRegion
    ReDim B(1 To UBound(A), 1 To UBound(A, 2))
    x = [k1]

    For i = 1 To UBound(A)
        If A(i, UBound(A, 2)) = x Then
            '>>>>>>>>>>>>>>
            For k = i To i + 1
                If k <= UBound(A) Then
                    s = s + 1
                    For j = 1 To UBound(A, 2)
                        B(s, j) = A(k, j)
                    Next j
                End If
            Next k
            '<<<<<<<<<<<<<<
        End If
    Next i

    Sheets(3).Select
    Cells.Clear
    Range("a1").Resize(s, UBound(A, 2)) = B
    Range("a1").Select
End Sub

提数附件2.rar (143.79 KB, 下载次数: 27)

2016-4-24 21:24 上传

点击文件名下载附件




如果没问题，就把3改成2

跳转到最佳答案楼层

爱疯

Sub Click()
    Dim A, B, i, j, k, x, s
    A = Sheets(1).Range("a1").CurrentRegion
    ReDim B(1 To UBound(A), 1 To UBound(A, 2))
    x = [k1]

    For i = 1 To UBound(A)
        If A(i, UBound(A, 2)) = x Then
            '>>>>>>>>>>>>>>
            For k = i To i + 1
                If k <= UBound(A) Then
                    s = s + 1
                    For j = 1 To UBound(A, 2)
                        B(s, j) = A(k, j)
                    Next j
                End If
            Next k
            '<<<<<<<<<<<<<<
        End If
    Next i

    Sheets(3).Select
    Cells.Clear
    Range("a1").Resize(s, UBound(A, 2)) = B
    Range("a1").Select
End Sub

提数附件2.rar (143.79 KB, 下载次数: 27)

2016-4-24 21:24 上传

点击文件名下载附件




如果没问题，就把3改成2

七彩屋

提数附件424.rar (131.17 KB, 下载次数: 17)

2016-4-24 21:38 上传

点击文件名下载附件

thelastdance

1. Sub dance()
   
2.     Dim arr, ar(1 To 10000, 1 To 9)
   
3.     arr = Range("a1:I" & Cells(Rows.Count, "I").End(3).Row)
   
4.     y = 0
   
5.     For x = 1 To UBound(arr)
   
6.     If arr(x, 9) = Cells(1, "k") Then
   
7.        y = y + 3
   
8.        For k = 1 To 9
   
9.        ar(y, k) = arr(x, k)
   
10.        ar(y + 1, k) = arr(x + 1, k)
    
11.        Next
    
12.     End If
    
13.     Next
    
14.     Sheets(2).Range("a1").Resize(10000, UBound(ar, 2)) = ar
    
15. End Sub

复制代码