利用VBA依据表头字段提取对应列数据？

edwin_gls

供参考，可以增加第一张表的数据

yeshuangyong

ykcbf1100 发表于 2023-8-11 15:15
你多拆分一列的话，写入的时候也要多写入一列。

绝对的牛，不是一般的牛

dgseg

请教各位老师，这个按钮只能清除前两列的数据，能不能改成清除所以填充的数据

章州

Sub 数据提取()
    Dim arr, brr, crr, drr, i&, j&, k&, m&
    Dim sht As Worksheet
    arr = Sheet1.UsedRange
    ReDim brr(1 To UBound(arr), 1 To 7)
    ReDim crr(1 To UBound(arr), 1 To 7)
    ReDim drr(1 To UBound(arr), 1 To 7)
    For i = 3 To UBound(arr)
        If arr(i, 7) = "七年级" Then
            k = k + 1
            brr(k, 1) = arr(i, 4)
            brr(k, 2) = arr(i, 6)
            brr(k, 3) = arr(i, 8)
            brr(k, 4) = arr(i, 2)
            brr(k, 5) = arr(i, 5)
            brr(k, 6) = arr(i, 11)
            brr(k, 7) = arr(i, 13)
        ElseIf arr(i, 7) = "八年级" Then
            j = j + 1
            crr(j, 1) = arr(i, 4)
            crr(j, 2) = arr(i, 6)
            crr(j, 3) = arr(i, 8)
            crr(j, 4) = arr(i, 2)
            crr(j, 5) = arr(i, 5)
            crr(j, 6) = arr(i, 11)
            crr(j, 7) = arr(i, 13)
        ElseIf arr(i, 7) = "九年级" Then
            m = m + 1
            drr(m, 1) = arr(i, 4)
            drr(m, 2) = arr(i, 6)
            drr(m, 3) = arr(i, 8)
            drr(m, 4) = arr(i, 2)
            drr(m, 5) = arr(i, 5)
            drr(m, 6) = arr(i, 11)
            drr(m, 7) = arr(i, 13)
        End If
    Next
    Sheet2.Range("A4").Resize(UBound(brr), UBound(brr, 2)) = brr
    Sheet3.Range("A4").Resize(UBound(crr), UBound(crr, 2)) = crr
    Sheet4.Range("A4").Resize(UBound(drr), UBound(drr, 2)) = drr
End Sub
我是这样写的

wang-way

A刘志勇

做好了，你试试