[已解决](VBA修改)提取数据

小蚊子

1032446692老师帮助我解决了这个问题，当时我忽略了，在一个工作簿上同时存在多个工作表，这样就不好使了，不知道在那需要修改,要求在《小班查询打印》L2为依据在《集材数据库》提取数据。

Sub test()
    Dim a, i, k, arra, arrb, cx
    cx = Sheets(2).[l2]
    a = Sheets(1).Cells(60000, 1).End(xlUp).Row
    arra = Sheets(1).Cells(1, 1).Resize(a, 14)
    ReDim arrb(1 To a, 1 To 9)
    For i = 3 To a
        If arra(i, 3) = cx Then
            k = k + 1
            arrb(k, 1) = arra(i, 1)
            arrb(k, 2) = arra(i, 2)
            arrb(k, 3) = arra(i, 4)
            arrb(k, 4) = arra(i, 5)
            arrb(k, 5) = arra(i, 6)
            arrb(k, 6) = arra(i, 7)
            arrb(k, 7) = arra(i, 8)
            arrb(k, 8) = arra(i, 9)
            arrb(k, 9) = arra(i, 10)
        End If
    Next i
    Sheets(2).Cells(7, 3).Resize(UBound(arrb), 9) = arrb
End Sub

最佳答案

月排行榜 / 总排行榜

1032446692

2013-5-27 23:37

Sub test()
    Dim a, i, k, arra, arrb, cx
    cx = Sheets(3).[l2]
    a = Sheets(2).Cells(60000, 1).End(xlUp).Row
    arra = Sheets(2).Cells(1, 1).Resize(a, 14)
    ReDim arrb(1 To a, 1 To 9)
    For i = 3 To a
        If arra(i, 3) = cx Then
            k = k + 1
            arrb(k, 1) = arra(i, 1)
            arrb(k, 2) = arra(i, 2)
            arrb(k, 3) = arra(i, 4)
            arrb(k, 4) = arra(i, 5)
            arrb(k, 5) = arra(i, 6)
            arrb(k, 6) = arra(i, 7)
            arrb(k, 7) = arra(i, 8)
            arrb(k, 8) = arra(i, 9)
            arrb(k, 9) = arra(i, 10)
        End If
    Next i
    Sheets(3).Cells(7, 3).Resize(UBound(arrb), 9) = arrb
End Sub

跳转到最佳答案楼层

lyf7276

你看你原来的帖子，我在下面还跟了个，你用第二个答案，就不会存在这个问题。不过我当时以为你只到L列，你把L改成Z

lyf7276

Sub kk()
Dim dyaq As Worksheet
Dim ovrn As Worksheet
Set dyaq = Sheets("小班查询打印")
Set ovrn = Sheets("集材数据库")
nn = dyaq.Cells.Find("*", , , , , xlPrevious).Row
dyaq.Range("c7:l" & nn).Delete
mm = dyaq.Range("l2")
mx = ovrn.Cells.Find(mm, , , , , xlNext).Row
my = ovrn.Cells.Find(mm, , , , , xlPrevious).Row

ovrn.Range("a" & mx & ":z" & my).Copy dyaq.Range("c7")
End Sub

1032446692

Sub test()
    Dim a, i, k, arra, arrb, cx
    cx = Sheets(3).[l2]
    a = Sheets(2).Cells(60000, 1).End(xlUp).Row
    arra = Sheets(2).Cells(1, 1).Resize(a, 14)
    ReDim arrb(1 To a, 1 To 9)
    For i = 3 To a
        If arra(i, 3) = cx Then
            k = k + 1
            arrb(k, 1) = arra(i, 1)
            arrb(k, 2) = arra(i, 2)
            arrb(k, 3) = arra(i, 4)
            arrb(k, 4) = arra(i, 5)
            arrb(k, 5) = arra(i, 6)
            arrb(k, 6) = arra(i, 7)
            arrb(k, 7) = arra(i, 8)
            arrb(k, 8) = arra(i, 9)
            arrb(k, 9) = arra(i, 10)
        End If
    Next i
    Sheets(3).Cells(7, 3).Resize(UBound(arrb), 9) = arrb
End Sub

小蚊子

1032446692 发表于 2013-5-27 23:37
Sub test()
    Dim a, i, k, arra, arrb, cx
    cx = Sheets(3).[l2]

谢谢，我知道我那地方没能明白了，现在成功了，