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

~泥巴坨~

求助：
“考场信息”表头字段固定
“七年级、八年级、九年级”三个表结构一样，如何依据表头字段（黑色区域第三行）提取所需字段下方全部信息？我搜索的代码如何改或者高手帮忙写一段代码？小白一枚

chxw68

详见附件。

cyq4896

参与一下..

ykcbf1100

参与一下。。。

~泥巴坨~

chxw68 发表于 2023-8-7 17:53
详见附件。

老师，我工作薄中还有其它多张工作表，请问如何指定提取的数据必须放在在七年级、八年级、九年级工作表呢？谢谢

chxw68

~泥巴坨~ 发表于 2023-8-8 10:35
老师，我工作薄中还有其它多张工作表，请问如何指定提取的数据必须放在在七年级、八年级、九年级工作表呢 ...

现在就是这么做的，有什么问题？最好举例说明。

~泥巴坨~

ykcbf1100 发表于 2023-8-7 18:54
参与一下。。。

增加一个拆分列号，这样怎么提示“下标越界”，小白不懂
    c = 8     '//拆分列号
    lc = 14   '//最大列号
    b = [{4,6,7,2,5,11,13,3}]
...

ykcbf1100

~泥巴坨~ 发表于 2023-8-11 14:55
增加一个拆分列号，这样怎么提示“下标越界”，小白不懂
    c = 8     '//拆分列号
    lc = 14   '// ...

你多拆分一列的话，写入的时候也要多写入一列。

~泥巴坨~

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

这里把7赋值给变量C表达的是什么意思？谢谢解答
c = 7     '//拆分列号，
    lc = 14   '//最大列号
    b = [{4,6,7,2,5,11,13,3,1}]
    Set sh = Sheets("考场信息")
.
.
.
Next
            With .[a4].Resize(m - 3, 9)

~泥巴坨~

chxw68 发表于 2023-8-8 10:43
现在就是这么做的，有什么问题？最好举例说明。

老师：麻烦看看我根据需要修改的代码哪里有问题？谢谢
Sub test()
'On Error Resume Next
    Dim r%, i%
    Dim arr, brr
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Worksheets("考场信息")
        .AutoFilterMode = False
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range("a3:n" & r)
    End With
    For i = 1 To UBound(arr)
        If Not d.exists(arr(i, 7)) Then
            Set d(arr(i, 7)) = CreateObject("scripting.dictionary")
        End If
        d(arr(i, 7))(i) = Empty
    Next
    For Each aa In d.keys
        With Worksheets(aa) '运行时这里提示下标越界
            ReDim brr(1 To d(aa).Count, 1 To 8)
            m = 0
            For Each bb In d(aa).keys
                m = m + 1
                'brr(m, 1) = arr(bb, 1) '序号
                brr(m, 2) = arr(bb, 4) '学籍号
                brr(m, 3) = arr(bb, 6) '身份证号
                brr(m, 4) = arr(bb, 8) '班级
                brr(m, 5) = arr(bb, 2) '姓名
                brr(m, 6) = arr(bb, 5) '考号
                brr(m, 7) = arr(bb, 11) '考场
                brr(m, 8) = arr(bb, 13) '考场号-----新增加一列关键字
            Next
            .UsedRange.Offset(3, 0).Resize(UBound(brr), 8).ClearContents '只清除1-8列数据？
            .Range("a:b,e:e").NumberFormatLocal = "@"
            .Range("a4").Resize(UBound(brr), UBound(brr, 2)) = brr
            With .UsedRange
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End With
    Next
End Sub