[已解决]数据整理（新问题）-请高手帮忙

diymywork

在“数据整理”表中已经可以按照规定格式整理好，但是现在要加上班级（新问题）信息，应该如何整理呢，请大家帮帮忙，想想办法，谢谢啦

最佳答案

月排行榜 / 总排行榜

zjdh

2012-3-19 12:58

数据整理-新问题2.rar (16.1 KB, 下载次数: 27)

2012-3-19 13:09 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

数据整理-新问题.rar (14.11 KB, 下载次数: 6)

2012-3-18 08:33 上传

点击文件名下载附件

TTTTT

昨天解决了你原来的问题，现在再来看你的新问题，感觉“班委”种类基本是固定的，而班级数量是可变的。
如果仅仅是1-9班，2楼代码是可以的，如果是2位数班级编号，或者有文字加数字的班级编号，2楼代码就有问题了。
如果“班委”种类是确定的，编程还比较容易，请楼主再确认一下。

zjdh

楼主附件只有一位数班级编码，多位数班级编码也不难：
数据整理-新问题.rar (14.47 KB, 下载次数: 33)

2012-3-18 10:12 上传

点击文件名下载附件

diymywork

zjdh 发表于 2012-3-18 10:05
楼主附件只有一位数班级编码，多位数班级编码也不难：

现在代码不是依据第三行 班级来提取数据的，能不能修改一下让他以第三行的班级提取数据呢？

diymywork

zjdh 发表于 2012-3-18 10:05
楼主附件只有一位数班级编码，多位数班级编码也不难：

如果班级格式是这个样子的呢？谢谢啦 高手

zjdh

数据整理-新问题2.rar (16.1 KB, 下载次数: 27)

2012-3-19 13:09 上传

点击文件名下载附件

TTTTT

根据“班委”种类编写的，参考一下：

zjdh

或者按你的宏修改：
Sub test2()
    Dim i&, j&, Myr&, Arr, brr()
    Dim d, k, t
    Set d = CreateObject("Scripting.Dictionary")
    Myr = Sheet2.[a65536].End(xlUp).Row
    Arr = Sheet2.Range("a3:b" & Myr)
    For i = 1 To UBound(Arr)
        d(Arr(i, 1)) = d(Arr(i, 1)) + 1
        d(Arr(i, 1) & d(Arr(i, 1))) = Arr(i, 2)
    Next
    Myr = Sheet2.[a65536].End(xlUp).Row
    Arr = Sheet2.Range("d4:d" & Myr)
    CRR = Range("E3:Z3")               '班级
   ReDim brr(1 To UBound(Arr), 1 To UBound(CRR, 2))
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(CRR, 2)
            brr(i, j) = d(CRR(1, j) & Arr(i, 1))
        Next
    Next
    Range("e4:iv1000").ClearContents
    Range("e4").Resize(UBound(brr), UBound(brr, 2)) = brr
    Set d = Nothing
End Sub

TTTTT

如果“班委”种类列在C列（可以增减），D列保持一列空白列，E列以后显示统一格式，参考一下