[已解决](VBA难题)提取数据

小蚊子

L2里面写上小班为依据，点击 查询 在《集材数据库》里提取和《小班查询打印》C6：K6向对应的数据填充到C6；K6下面，画出边框（在有数据的地方C1到K列有数据的自动设置为打印区域。）括号里面的没办法弄也可以，我在慢慢研究别的办法。谢谢

最佳答案

月排行榜 / 总排行榜

1032446692

2013-5-27 11:20

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

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

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 & ":l" & my).Copy dyaq.Range("c7")
End Sub

1091126096

来学习的